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INTRODUCTION 



The Scientific Subroutine Package (SSP) for Oper- 
ating System/360 PL/l is a set of basic computa- 
tional subroutines intended to help the user develop 
his own PL/I program library. The user may sup- 
plement or modify the subroutines to meet his needs. 
This package includes a wide variety of subroutines 
to perform the functions listed below but is not 
intended to be exhaustive in terms of either functions 
performed or methods used. As with all tools, the 
user should understand their capabilities and their 
application to his functional requirements before 
deciding to use them. 

AREAS OF APPLICATION 

Individual subroutines or a combination of them can 
be used for the general areas listed here. 

Mathematics 

Matrix operations 

Elementary 

Linear equations 

Eigenvalues 
Polynomial operations 

Orthogonal polynomials 

Polynomial economization 

Polynomial roots 
Numerical quadrature 

Tabulated functions 

Nontabulated functions 
Numerical differentiation 

Tabulated functions 

Nontabulated functions 
Interpolation of tabulated functions 
Approximation of tabulated functions 
Smoothing of tabulated functions 
Roots and extrema of functions 
Systems of ordinary differential equations 
Special mathematical functions 

Statistics 

Data screening and analysis 

Elementary statistics 

Correlation and regression analysis 

Correlation 

Multiple linear regression 

Stepwise multiple regression 

Canonical correlation 
Analysis of variance 
Discriminant analysis 
Principal components analysis 
Nonparametric statistics 
Distribution functions 



IBM REFERENCE MATERIAL 

System/360 Scientific Subroutine Package 
(360A-CM-03X) Version HI Programmer's 
Manual (H20-0205) 

IBM System/360 Operating System PL/l (F) 
Reference Manual (C28-8201) 

IBM System/360 Operating System PL/l (F) 
Programmer's Guide (C28-6594) 

Preface to PL/I Programming in 
Scientific Computing (E20-0312) 

CHARACTERISTICS 

Some of the characteristics of SSP/360 (PL/l) are 
as follows: 

• All subroutines are free of input/output 
statements. 

• All subroutines are written in OS/360 PL/l (F). 

• Most of the subroutines provide a double- 
precision option. 

• The use of certain subroutines (or groups of 
them) is illustrated in the program documen- 
tation by sample main programs with input/ 
output. 

• All subroutines are documented uniformly. 
An example of a sample main program that uses 

several of the subroutines is the statistical function 
called Principal Components Analysis (FACT).* 
It uses five separate subroutine capabilities, as 
follows: 

• Computation of means , standard deviations, 
and correlation matrix (CORR) 

• Computation of eigenvalues and eigenvectors 
of the correlation matrix (MSDU) 
Selection of eigenvalues (TRAC) 
Computation of factor matrix (LOAD) 
Varimax rotation of the factor matrix (VRMX) 

This is one of the sample main programs 
included in the program documentation. 






*This program performs the same functions as the 
program that was called Factor Analysis in the 
FORTRAN versions of SSP. The name Principal 
Components Analysis more aptly describes the 
function of this program than the name Factor 
Analysis. For a discussion of the distinction 
between Factor Analysis and Principal Components 
Analysis see Section 2. 2 of 1130 Statistical System 
(1130-CA-06X) User's Manual (H20-0333K 



REQUIRED SYSTEMS Machine Configuration 

Programming Systems A minimum requirement is a System/360 suitable 

for the OS/360 PL/l (F) compiler. The machine 
The subroutines are written in the PL/l language, configuration required for any given problem 

using the 48-character set and the facilities pro- depends on the number of subroutines used, the 

vided by the PL/l (F) compiler, which functions size of the compiled subroutines, the size of the 

under Operating System/360. compiled main program, the size of the control 

program, and the data storage requirements. 



OVERALL RULES OF USAGE 



GENERAL RULES 

All subroutines in SSP are entered by means of the 
standard PL/l CALL statement. The subroutines 
are purely computational in nature and do not con- 
tain any references to input/output devices. The 
user must therefore furnish, as part of his program, 
the input/output and other operations necessary for 
She total solution of his problem. He must also 
define by DECLARE statements all matrices to be 
operated on by SSP subroutines as well as those 
matrices utilized in his program. The subroutines 
contained in SSP are used like any user- supplied 
subroutine. All of the normal rules of PL/l con- 
cerning subroutines must therefore be followed. 
Note that the subroutines have been written using the 
48-character set, so the programmer should be 
familiar with its use. 

All variables in the calling program must be 
declared with the proper attributes. Those vari- 
ables appearing as parameters in the call statement 
of the calling program should not have attributes 
conflicting with those of the called program. 

The CALL statement transfers control to the 
subroutine and replaces the dummy variables in 
that subroutine with the value of the actual argu- 
ments that appear in the CALL statement. When 
the argument is an array, the address and size of 
the array are transmitted to the called subroutine. 

The arguments in a CALL statement should agree 
in order, number, and type with the corresponding 
arguments in the subroutine. In SSP, all arguments 
in a CALL statement must be variable names. 
Constants are not acceptable. For example, if the 
user wishes to invert a matrix A, which is 10 by 10, 
using the SSP subroutine MINV, and if the constant 
for testing the condition of the matrix is 10" §, 
these constants must be defined as variables before 
calling MINV, as illustrated below: 

N = 10, , 

CON = 1,0 E - 8, . 

CALL MINV (A, N, D, CON), . 

where D is the determinant. 

Some of the subroutines in SSP require the name 
of a user function subprogram or a PL/I- supplied 
function name as part of the argument list in the 



CALL statement. If the user's program contains 
such a CALL, the function name appearing in the 
argument list must be declared as ENTRY in the 
user's calling program. 

For example, the SSP routine SBST calls a user- 
supplied subroutine. The user must, therefore, 
prepare a subroutine, with the proper argument 
list, to perform the desired tasks. He must 
declare the name of this subroutine as ENTRY in 
his calling program and supply the name of that 
subroutine to SBST as the appropriate parameter in 
his CALL statement to subroutine SBST. The sub- 
routine SBST need not be modified by the user. The 
dummy argument B in the subroutine SBST is 
replaced by the user's subroutine name at execution 
time. 

The following illustrates these procedures: 

SSP Subroutine SBST (need not be altered) 

SBST. , 

PROCEDURE (A, C, R, B, S, NO, NV, NC),. 
DECLARE 

B ENTRY, . 



CALL B (R, TR), , 



RETURN, . 
END, . 

User's Calling Program 

USER. . 

PROCEDURE OPTIONS (MAIN), . 
DECLARE 

BOOL ENTRY, . 



CALL SBST (A. C, R, BOOL, S, NO, NX, 
NC),. 



RETURN, . 
END, . 



User's Function Subprogram 

BOOL. . 

PROCEDURE (R, T), . 



RETURN, . 
END, . 

ERROR CODES 

In the Scientific Subroutine Package most of the 
subroutines use an error indicator to warn the 
user that a certain condition exists. The user, in 
his calling program, should check the error indi- 
cator when returning from a called program. If 
the user wishes to use the error indicator as an aid, 
he should, in his calling program, declare ERROR 
EXTERNAL CHARACTER(l). In this way he has 
available in the calling program the value of the 
error indicator (ERROR). 

If, in using a subroutine, an error is detected, 
some of the output areas may contain invalid data. 
Generally, however, output areas are set to appro- 
priate values (for example, zero or ± lo'''^). 

MATRIX OPERATIONS 

Special consideration must be given to the sub- 
routines that perform matrix operations. These 
subroutines have two characteristics that affect the 
size and format of the data in storage: variable 
dimensioning and data storage compression. 

Variable Dimensioning 

Those subroutines that deal with matrices can 
operate on any size array, limited in most cases 
only by the available core storage and numerical 
analysis considerations. The subroutines do not 
contain fixed maximum dimensions for data arrays 
named in their callii^ sequence. The variable 
dimension capability has been implemented in SSP 
by usii^ the asterisk notation. Under this approach, 
where a called subroutine needs to declare an array 
of the same dimensions as a callii^ program, the 
dimension specifications are replaced by asterisks. 
Thus, the user does not need to modify the sub- 
routines so long as he has declared adequate dimen- 
sions for arrays in the calling program or main 
program. 

One way to ensure that arrays have adequate 
dimensions for various problems is to declare them 
with variable notations. For example, if matrix R 



contains intercorrelation coefficients among M 
variables, the DECLARE statement appears as 
follows: 

DECLARE R(M,M), . 

If M is 10, then 100 locations will be allocated for 
matrix R. 

If M is 20, then 400 locations will be allocated 
automatically. 

Storage Compression 

When working with symmetric matrices it is often 
advantageous to use a compressed (vector) storage 
form. This means that only the upper or lower 
triai^ular part of the matrix need be stored, which 
for an N by N matrix reduces the core requirements 
from N^ locations to N(N+l)/2 locations. A sub- 
routine, MSCS, is provided in this package which 
stores a symmetric matrix in compressed form and 
at the same time tests the matrix for symmetry. 
The element stored is the average of each pair of 
symmetric elements of an n by n matrix Q, i. e. , 



Sik - 



Qik + Qki 



k 



1, . 
1, . 



n. 
1. 



At the same time the difference Qjj^ - Qj^.^ is 
tested against a user-supplied tolerance. If this test 
fails, an ERROR indication is given but in any case 
the results Sy^ are supplied in the vector form: 



^11' ^21' ^22' ^31' ^2' ^33 



. S 



nn 



Anoiher subroutine, MSCG, is provided which con- 
verts this vector (compressed) form back to the 
general two-dimensional form. 

Some of the subroutines of SSP — for example, 
MMSS and MAGS — accept input in this compressed 
form. 

DOUBLE PRECISION 

The accuracy of the computations in many of the 
SSP subroutines is highly dependent upon the number 
of significant digits available for arithmetic 
operations. Matrix inversion, integration, and 
many of the statistical subroutines fall into this cate- 
gory. The user may, therefore, wish to use double- 
precision versions of these subroutines. Most of 
the SSP/360 (PL/I) subroutines provide a double- 
precision option. PL/I double-precision statements 
have been included in each of these subroutines in 



the form of a comments card. The double-precision 
version of the subroutine can be obtained by remov- 
ing/* from cc 3 and 4 of the double-precision state- 
ment card(s) and by removing the corresponding 
single-precision cards (or making them comments 
cards) before compilation. The use of double- 
precision subroutines requires a detailed knowledge 
of the PL/I rules concerning double precision. Two 
of the more basic rules are as follows: 

1. Any real variable, vector, or array name 
contained in the argument list of a CALL to a 
double-precision subroutine must be declared as 
double precision in the calling program, 

2. Any user-supplied function named in the CALL 
statement for a double-precision SSP subroutine must 
be programmed as a double-precision function. 



FORMAT OF THE DOCUMENTATION 

The major portion of this manual consists of the 
documentation for the individual subroutines and 
sample programs. 

SUBROUTINE DESCRIPTIONS 

Subroutines and sample program guides, both cate- 
gorical and alphabetic, designed to help locate par- 
ticular subroutines are given in the pages that 
follow. 

The subroutine descriptions, in general, consist 
of purpose, usage, remarks, method, mathematical 
background, programming considerations, and a 
program listing. References to books and peri- 
odicals will be found under the method section of the 
description. The mathematical description pages 
do not, in all cases, indicate the derivation of the 
mathematics , They are intended to indicate what 
mathematical operations are actually being per- 
formed in the subroutines. 



SAMPLE PROGRAM DESCRIPTIONS 

A sample program, in general, consists of a de- 
scription of the problem, program, input, output, 
program modification, operating instructions, error 
messages, timing, machine listing of the program, 
sample input data, and output results. M some 
cases (for example, as a part of developing the data 
screening sample program) a special sample sub- 
routine has been implemented that may prove useful 
to the programmer. One such subroutine, called 
HIST, prints a histogram of frequencies. The listing 
of these subroutines is included after the sample 
program documentation in this manual. 

Instructions for modifying the sample programs 
for different data formats are included in the docu- 
mentation. In addition, those sample programs that 
illustrate potentially double-precision subroutines 
include double-precision statements in the form of 
comment cards. These comment cards are contained 
in the sample program source decks. 

OPERATING NOTES 

It is recommended that those SSP subroutines that 
will be frequently used in an installation be compiled 
and that the relocatable programs be placed on the 
PL/I systems residence device. In the case of 
Operating System/360, this will be the PL/I library 
portion of the system disk pack. Information on the 
method for updating the system to include user- 
supplied subroutines appears in the appropriate PL/l 
programmer's guide. SSP subroutines are handled 
in the same manner as user-supplied subroutines. 
If the subroutines are not placed in the PL/l library, 
those required by a particular program will have to 
be included in that program each time it is run. As 
noted earlier, the subroutines have been written using 
the 48-character set. 



CATEGORICAL GUIDE TO SUBROUTINES AND 
SAMPLE PROGRAMS 
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Matrix Operations 



Elementary Operations 
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MMSS 

MMGT 
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MTI»I 

l.:_-FiT 



Storage conversion — two- 
dimensional to compressed 
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pressed to two-dimensional 
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sjanraetxne matrices 
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matrices 
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matrices 
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MG 


14 




14 
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^MINV 
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IS 
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20 
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matrix 

Solution of a system of 
linear equations, the least 
sauares solution being 
obtained in case of an over- 
determined system 
Solution of simultaneous 
linear equations with band 
matrix of coefficients 



Eigenvalues and Related Topics 
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V MATU 

MSTU 

v^EAT 
MEST 
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MVST 

MSDU 
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means of populations 



194 



196 



197 



200 



204 



206 



Discriminant Analysis 

DMTX Means and dispersion matrix 209 

for all groups 
DSCR Discriminant functions 210 

Principal Components Analysis 



TRAC Cumulative percentage of 

eigenvalues 
LOAD Factor loading 
VRMX Varimax rotation 

Nonparametrlc Statistics 


213 

214 
215 



KLMO 

KLM2 

SMIR 



Kolmogorov-Smimov one- 218 
sample test 

Kolmogorov-Smlmov two- 221 
sample test 

Kolmogorov-Smimov limit- 223 
ing distribution values 



CHSQ 

KRNK 
QTST 
RANK 
SRNK 
TIE 

TWAV 

UTST 
WTST 

HTES 



Chi-square test for 

contingency tables 

Kendall rank correlation 

Cochran Q-test 

Rank observation 

Spearman rank correlation 

Calculation of correction 

factor due to ties 

Friedmann two-way analysis 234 

of variance statistic 

Mann-Whitney U-test 235 

Kendall coefficient of 236 

concordance 

Kruskal-Wallis H-test 238 



224 

227 
229 
230 
231 
233 



Distribution Functions 



NDTR 
BDTR 
CDTR 

NDTI 



Normal distribution function 239 

Beta distribution function 240 

Chl-square distribution 243 
function 

Inverse of normal distribu- 
tion function 246 



GUIDE TO SAMPLE PROGRAMS 



Data Screening 



DACR 



Illustrates use of: 



Sample main program 



SBST 



TABl 



Subset selection from 
observation matrix 
Tabulation of data (one 
variable) 



255 

184 
185 



Special sample subroutines are: 

BOOL Boolean expression 

HIST Histogram printing 

DATl Sample data read 

Multiple Linear Regression 



REGR 



Sample main program 



259 
259 
259 



260 



Illustrates use of: 

CORR Means, standard deviations, 194 

and correlations 
ORDR Rearrangement of 

Intercorrelatlons 
MINV Matrix inversion 

MLTR Multiple regression 

Special sample subroutines are: 
DAT2 Sample data read 

IDTl Sample binary fixed data 

read 



196 

44 
197 

265 
265 



Page 



Page 



Stepwise Multiple Regression 

STEP Sample main program 

Illustrates use of: 

CORR Means, standard deviations, 

aixd correlations 
STRG Stepwise multiple 

regression 
Special sample subroutines are: 

DAT2 Sample data read sub- 

routine 
IDT2 Sample binary fixed data 

read 
sour Sample stepwise regression 

output subroutine 

Canonical Correlation 



Principal Components Analysis 



265 


FACT 


Sample main program 


281 




Illustrates the 


use of: 




194 


CORR 


Means, standard deviations, 
and correlations 


194 


200 


MSDU 


Eigenvalues and eigen- 
vectors of a real symmetric 

matrix 


69 


270 


TRAC 


Cumulative percentage of 
eigenvalues 


213 


270 


LOAD 


Factor loading 


214 




VRMX 


Varimax rotation 


215 


270 


Special sample subroutine is: 






DAT2 


Sample data read 


286 




Kolmogorov-Smirnov Test 





CANO 




Sample main program 


270 


Illustrates 


use 


of: 




CORR 




Means, standard deviations, 
and correlations 


194 


CANC 




Canonical correlation 


:^04 


MINV 




Matrix inversion 


44 


MGDU 




Eigenvalues and eigen- 
vectors of a special 
general matrix 


71 


MSUU 




Eigenvalue^ iind eigen- 
vectors of a symmetric 
matrix 


89 


Spec.ui. s rumple 


'■ subroutine is: 




DA'i2 




Sample data read 


274 


Analysis oi 


111 


i'iapce 





ANOV 



Sample main program 



Illustrates the use of; 

AVAR iiiialysis of variance 

Special sample subroutine is: 

DATS Sample data read 

Discriminant Analysis 



274 

206 

277 



KOLM Sample main program 

Illustrates the use of: 

KLMO One sample test 

KLM2 Two sample test 

SMIR Kolmogorov-Smirnov limit- 

ing distribution function 

NDTR Normal distribution function 

Triple Exponential Smoothing 

EXPN Sample main program 

Illustrates the use of: 

EXSM Triple exponential smoothing 

Special sample subroutine is: 

DATS Sample data read 

Allocation of Overhead Costs 

COST Sample main program 

Illustrates the use of: 

MFG Matrix triangular factoriza- 

tion 
MDLG Division by triangular 

matrices 



286 

218 
221 

223 
239 



291 
152 
293 

294 
23 
39 



MDSC Sample main program 

Illustrates the use of: 

DMTX Means and dispersion matrix 

MINV Matrix inversion 

DSCR Discriminant analysis 

Special sample subroutine is: 

DAT2 Sample data read 



277 

209 

44 
210 

281 
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ALPHABETIC GUIDE TO SUBROUTINES AND 
SAMPLE PROGRAMS, WITH STORAGE 
REQUIREMENTS 

The following table lists the number of bytes of 
storage for the program control section required by 
each of the subroutines in the Scientific Subroutine 
Package. The storage requirements were obtained 
by using Version 4 of PL/I and Release 16 of OS. 
The use of other versions and releases may cause 
deviations from these figures. 

The double-precision version storage require- 
ments of the subroutines in the Scientific Subroutine 
Package are included in parentheses. 



Name 

ABST 
ACFMI 

acfe/ 

AHIM ) 

AHiE ; 

ALIM ) 

ALIE / 

A NOV 

APCl ) 

APC2 / 

APLL 

ASN 

AVAR 

BDTR 

BOOL 

BOUN 

GANG 

GANG 

GDTR 

GELl ) 

CEL2 i 

GHSQ 

GORR 

GOST 

DAGR 

DATl 

DAT2 

DATS 

DERE 

DET3 

DET5 

DFEG 

DFEO 

DGT3 

DMTX 

DSCR 

ELIl \ 

ELI2 f 

EXPN 

EXSM 



Math. Description 
Page Number 

183 

126 

126 

122 

122 

118 

118 

274 

140 

140 

139 

143 

206 

240 

259 

182 

204 

270 

243 

172 

172 

224 

194 

294 

255 

259 

265 

277 

167 

108 

110 

112 

115 

107 

209 

210 

174 

174 

291 

152 



Storage Required 
Bytes 

610 

2,826 (2,696) 

2,946 (2,950) 

2,306 (2,310) 

4,482 

1,766(1,766) 

986 (986) 
1,902 (1,874) 
4, 174 (4, 174) 
3,830 

266 
1,102 

4,718 (4,718) 
5,478 
3,962 

858 (854) 

3,882 

4,352 (4,408) 

3,206 

4,294 

1,098 

1,098 

850 
2,762 (2,738) 

658 (658) 

890 (890) 
1,142 (1,142) 
1,118 (1,118) 

894 (894) 
2,498 (2,510) 
3,090 (3,110) 

1,458 (1,454) 

2,430 
1,030 



Math. DescriptioD 
Name Page Number 

FACT 281 

FFT 129 

FFTM 134 

FMFP 153 

HIST 259 

HTES 238 

IDTl 265 

IDT2 270 

JELF 177 

KLMO 218 

KLM2 221 

KOLM 286 

KRNK 227 

LGAM 180 

LOAD 214 

MAGS 14 

MATE 56 

MATU 58 

MDLG 39 

MDLS ) 35 

MDRS / 35 

MDSB 37 

MDSC 277 

MEAT 61 

MEBS 66 

MEST 63 

MFG 23 

MFGR 29 

MFS 25 

MFSB 27 

MGBl ) 49 

MGB2 / 49 

MGDU 71 

MIG 40 

MINV 44 

MIS 42 

MLSQ 45 

MLTR 197 

MMGG 15 

MMGS 17 

MMGT 18 

MMSS 16 

MOMN 191 

MPRM 19 

MPIT 21 

MSCG 14 

MSCS 13 

MSDU 69 

MSTU 59 

MTPI 20 



Storage Required 
Bytes 

7,ii6 

3, 166 (3, IGo) 

4,040 (;,040) 

4, 174 (4, 040) 

2,674 

1,122 

614 

614 
1,270 (1,270) 
2,010 
1,998 
6,828 
2,010 

750 

666 (666) 

638 (638) 
1,706 
1,918 
1,314 

1,426 (1,414) 

1,202 (1 186) 
6,482 
5, 638 
1,066 
1,890 

1,882 (1,85b; 

2,730 (2,714) 

886 (874) 

1,158 (1,142) 

3,562 (3,550) 



2,274 

1,894 

3,014 

1,198 

3,622 

2,098 

630 

1,062 

858 

718 

2,078 

1,078 

730 

474 

626 

3,538 

2,426 

674 



(2,274) 

(1, 858) 

(3,014) 

(1,182) 

(3,558) 

(2,098) 

(622) 

(1,058) 

(846) 

(710) 

(1,078) 

(474) 

(626) 

(3,538) 
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Math. Description 


Storage Required 




Math. Description 


Storage Required 


Name 


Page Number 

72 


Bytes 


Name 
QL2 


Page Number 
101 


Bytes 


MVAT 


5,782 




362 (354) 


MVEB 


76 


1,294 




QL4 


101 


510 (490) 


MVST 


67 


3,254 




QL8 


101 


398 (398) 


MVSU 


74 


1,182 




QL12 


101 


402 (402) 


MVUB 


75 


1,518 




QL16 


101 


402 (402) 


NDTI 


246 


834 




QL24 


101 


398 (394) 


NDTR 


239 


450 




QSF 


93 


710 (710) 


ORDR 
PEC ) 
PTC f 


196 

81 
81 


1,238 
2,082 


(1,238) 
(2,090) 


QTFGl 
QTFE / 
QTST 


92 

92 

229 


702 (702) 
1,462 


POST 


86 


1,322 


(1,322) 


RANK 


230 


962 


POSV 


78 


798 


(790) 


REGR 


260 


7,930 


POV 


77 


722 


(714) 


RTF 


159 


1,878 (1,882) 


PRTC 


87 


2,686 


(2,718) 


RTFD 


163 


1,762 (1,762) 


QA2 


105 


362 


(354) 


SBST 


184 


1,562 


QA4 


105 


510 


(490) 


SE13 ) 
SG13 f 


147 


1,118 (1,118) 


QA8 


105 


398 


(398) 






QA12 


105 


402 


(402) 


SE15 


149 


730 (730) 


QA16 


105 


402 


(402) 


SE35 


150 


774 (774) 


QA24 


105 


398 


(394) 


SMIR 


223 


710 


QATR 


97 


1,318 


(1,318) 


SRNK 


231 


1,558 


QG2 


99 


422 


(422) 


SOUT 


270 


3,458 


QG4 


99 


574 


(554) 


STEP 


265 


5,494 


QG8 


99 


534 


(526) 


STRG 


200 


4,914 (4,950) 


QG16 


99 


538 


(530) 


SUBM 


190 


790 


QG24 


99 


538 


(530) 


TABl 


185 


2,642 


QG32 


99 


538 


(530) 


TAB2 


187 


4,894 


QG48 


99 


530 


(522) 


TALY 


181 


2,090 


QH2 


103 


346 


(342) 


TIE 


233 


926 


QH4 


103 


474 


(466) 


TRAC 


213 


818 (818) 


QHS 


103 


454 


(450) 


TTST 


192 


2,562 


QH16 


103 


458 


(454) 


TWAV 


234 


1,562 


QH24 


103 


458 


(454) 


UTST 


235 


1,302 


QH32 


103 


458 


(454) 


VRMX 


215 


3,970 (3,852) 


QH48 


103 


450 


(446) 


WTST 


236 


1,986 


QHFG 


94 












QHFE 


94 


1,178 


(1,178) 








QHSG 


94 












QHSE 


94 
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SUBROUTINE DESCRIPTIONS AND LISTINGS 

MATHEMATICS 

Matrix Operations 

Elementary Operations 

• Subroutine MSCS 



MSCS,. 




"~" 


MSCS 10 


/*»*««»»****»,«**«**♦*», *«******«*«*«******«»»«**«««***«»,«*««*««««»„/„5CS 20 1 


/* 






*/MSCS 30 


/* CONVERT THE STORAGE ALLOCATION OF A SYHMETRIC HATRIX 




♦/MSCS *tO 


/* FROM A TWO-DIMENSIONAL ABPAY 


TO A LINEAR ARRAY 




*/MSCS 50 


/* 






*/MSCS 50 


/*******************************t»»*t:*tt.t**********m********m9:,ii0»m^c* 


♦♦/MSCS 70 


PROCEOUREiO.N.EPS.S),, 






MSCS 80 


DECLARE 






MSCS 90 


CQ(*f*),EPS,S(«),Ql,Q2,H) 






MSCS 100 


BINARY FLOAT. 


/♦SINGLE PRECISION VERSION 


/*S^/MSCS 110 1 


/* BINARY FL0AT(53) , 


/•DOUBLE PRECISION VERSION 


/♦ 


0«/MSCS 120 


(N.I.K.LieiNARY FIXED, 






MSCS 130 


ERROR EXTERNAL CHARACTER{ I) , 






MSCS 140 


ERROR='0',. 


/•PRESET ERROR INDICATOR 




•/MSCS 150 


L -:0,. 






MSCS 160 


IF N GT 


/♦TEST SPECIFIED DIHENSION 




♦/MSCS 170 


THEN 00 I =1 TO N,. 






MSCS UO 


00 K =1 TO I , . 






MSCS 190 


L =L*1.. 






MSCS 200 


01 =0(1, K).. 


/♦REPLACE Ql BY Q(I,KI 




♦/MSCS 210 


02 =Q(K,I),. 


/♦REPLACE 02 BY OIK, 11 




•/MSCS 220 


S(L) ,M=(Q1+Q2»*0.5,. 


/♦SET RES, SIL» =(01+021/2 




•/MSCS 230 


IF ABS(Ql-Q2) GT 


/♦TEST FOR SYMMETRY OF 




♦/MSCS 2*0 


EPS»MAX(1,A8S(«)) 






MSCS 250 


THEN ERRQR=',S*,. 


/*Q IS NOT SYMMETRIC 




♦/MSCS 260 


END,. 






MSCS 270 


END, . 






MSCS 280 


ELSE EftROR='D',. 


/♦ERROR IN SPECIFIED DIMENSION 


♦/MSCS 290 


END,. 


/♦END OF PROCEDURE MSCS 




•/MSCS 300 



ERROR='S' means given matrix Q does not pass 

the specified symmetry test. Nonethe- 
less, all of the elements Sy^ are com- 
puted as shown below and stored in S. 



Method: 



ik 



^ik " %i 



for i=l, 2, . . .,n 
k=l,...,i 



Symmetry -test: 



Qik - Qki i"ust be absolutely less than 
Max (1, I'^ki + Qik I) *Eps 



Purpose: 

MSCS compresses the storage allocation of a sym- 
metric two-dimensional matrix to a one-dimensional 
array. 

Usage: 

CALL MSCS (Q, N, EPS, S); 



Q(N,N)- 



N- 



EPS 



S(N*(N+ l)/2) 



Remarks: 



BINARY FLOAT [(53)] 
Given N by N symmetric matrix. 
BINARY FIXED 

Given order of matrices Q and S. 
BINARY FLOAT [(53)] 
Given relative tolerance for test on 
symmetry. 

BINARY FLOAT [(53)] 
Resultant symmetric matrix in one- 
dimensional compressed form. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR = 'D' means N is less than 1. 
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Subroutine MSCG 



• Subroutine MAGS 



MSCG.. 








MSCG 


IC 


/*iti********"»«»**»:if*«W***ir*****,* 


»****■>,* t"************************* 


♦*«(.*/MSCG 


2C 










*/MSCG 


30 




CONVERT THE STORAGE ALLOCATION np A SYMMETRIC MATRIX 


•/MSCG 


«0 




FPOM A LINEAR APRAY TO A 


TWO 


-D[MENSIONAL ARRAY 


*/MSCG 


50 










•/MSCG 


60 


/(■**********»<■**<.*«***»«*»««**!«!* 




**««*/MSCG 


70 


Ppr)CEDUPElS,N,0),. 






MSCG 


8C 


DECLARE 






MSCG 


90 




(S(*1,0(*.*) ) 






MSCG 


100 




BINARY FLOAT, 




/•SINGLE PRECISION VERSION 


/*S*/MSCG 


110 


/* 


BINARY FL0ATI53), 




/•DOUBLE PRECISION VERSION 


/•0*/MSCG 


120 




(N,I,K,L)6INARY FIXED,. 






MSCG 


130 


L 


=0,. 






MSCG 


lAO 


IF N 


GT C 




/*T£ST SPECIFIED DIMENSION 


♦/MSCG 


150 


THEN 


DC I =1 TO N,. 






MSCG 


160 




DO K. =1 TO I,. 






MSCG 


170 




L =L+1,. 






MSCG 


180 




Ol!.Kt,Q(K,lJ=S(L) , 




/*STORE 0(1. K) AND QIK, I) 


•/MSCG 


190 




END,. 






MSCG 


200 




END.. 






MSCG 


210 


ENO, 






/»END OF PROCEDURE MSCG 


*/MSCG 


220 



Purpose: 

MSCG expands the compressed one-dimensional 
storage allocation of a symmetric matrix to general 
two-dimensional form. 

Usage: 

CALL MSCG (S, N, Q); 

S(N*(N+l)/2) - BINARY FLOAT [(53)] 

Given one -dimensional array 
representing a symmetric N by N 
matrix in compressed form. 

N - BINARY FIXED 

Given order of matrices S and Q. 

Q(N, N) - BINARY FLOAT [(53)] 

Resultant two-dimensional general 
representation of given symmetric 
matrix S. 

Remarks: 

Operation is bypassed in case of a nonpositive value 
of N. The elements of given S are assumed to be 
stored in compressed form — that is: 



^^ir V V ^31' ^32' V"-' ^■ 

S ) 
nn 



Method: 

For the elements of resultant Q: 



Q., = Q, . = S., for i = 1, 2, ...,n 
ik ki ik , , ' 

k = 1, 2, . . . , 1 



nl' 



MAGS.. 










MAGS 


■"1 


/»«««««««*»* 


(!*****«* ****** 


**«***»***:« 




' ' .■'^AG> 




/* 










■./rtAGS 


i- \ 


/» 


ADD 


:R SUBTRACT A 


SQUARE AND 


A SYMMETRIC MATRIX 


•/MAGS 


4C 


/• 










*/'^AGS 


5C 


/*««*«*«*««« 




**t 4'**m*******v*********************f:* ******* /IHHI^S 


60 


PROCEDURE (A,8,N,0PT,C), 






MAGS 


70 


DECLARE 








MAGS 


80 




(A(* 


•) ,B(*1 ,C(*.^ 


) .AL.BLt 




MAGS 


90 




BINARY FLOAT, 




/•SINGLE PRECISION VERSION 


*S*/1AGS 


IOC 


/* 


BINARY FLOAT(53), 




/*DOUBLE PRECISION VFRSION /*0*/M4GS 


110 




(N,I 


K.LfLUBINARY 


FIXED, 




M-^S 


120 




OPT 


.HARACTERIl) ,. 






fAGS 


130 


IF N 


GT 






/*1S N GREATER THAN ZERO 


•/MAGS 


140 


THEN 


00,. 








MAGS 


150 




LI, I 


^1,. 






MAGS 


160 


NEXTI.. 










MAGS 


170 




L 


= LI,. 






MAGS 


180 




K 


= 1,. 






MAGS 


190 


NEXTK,. 










MAGS 


200 




AL 


=A(I,K),. 




/•REPLACE AL BY A(1,K) 


•/MAGS 


210 




BL 


=6(L),. 




/•SET BL CORRESPONDING TO AL 


•/MAGS 


220 




IF K 


LT I 






MAGS 


230 




THEN 


L =L+1,. 






MAGS 


2^0 




ELSE 


L =LtK,. 






MAGS 


250 




IF 0PT='2' 




/•SHOULD A-B BE CALCULATED 


•/MAGS 


260 




THEN 


BL =-9L,. 




/♦THEN CONVERT SIGN OF BL 


•/MAGS 


270 




ELSE 


IF QPT='3' 




/•SHOULD B-A BE CALCULATED 


♦/MAGS 


280 




THEN 


AL =-AL,. 




/•THEN CONVERT SIGN OF AL 


♦/MAGS 


290 




C( [. 


Kl=AL+eL,. 




/♦SET RESULTANT C(I,K) TO AL+BL^/MAGS 


300 




IF K 


LT N 






MAGS 


310 




THEN 


00.. 

K =K+1,. 

GO TO NEXTK,. 

END,. 




/•INCREMENT K 


•/MAGS 
HAGS 
MAGS 
MAGS 


320 
330 
340 

350 




ELSE 


IF I LT N 






MAGS 


36G 




THEN 


00,. 

LI =L1*I,, 

1 =1*1,. 

GO TO NEXTI,. 

END,. 




/•INCREMENT I 


•/MAGS 
MAGS 
MAGS 
MAGS 
MAGS 


370 
380 
390 
400 
410 




ENO, 








MAGS 


420, 


END, 


• 






/•END OF PROCEDURE MAGS 


♦/MAGS 


430| 



Purpose: 
MAGS computes 



C = A + B if OPT = '1' 
C = A - B if OPT = '2' 
C = B - A if OPT = '3' 



for given matrices A and B which are general and 
symmetric respectively. 

Usage: 

CALL MAGS (A, B, N, OPT, C); 

A(N, N) - BINARY FLOAT [(53)] 

Given general N by N matrix. 

B(N*(N+l)/2) -BINARY FLOAT [(53)] 

Given one-dimensional array con- 
taining the lower triangular part of 
symmetric matrix B stored rowwise 
in compressed form. 

N - BINARY FIXED 

Given order of matrices A, B and C. 

OPT - CHARACTER(l) 

Given option for selection of opera- 
tion. 

C(N,N) - BINARY FLOAT [(53)] 

Resultant general N by N matrix, 
which may be overlaid with A. 



Remarks: 

Operation is bypassed in case of a nonpositive value 
of N. A value of OPT different from '2' and '3' is 
treated as if it were '1'. 
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Method: 



• Subroutine MMGG 



The sum or difference of matrices A and B is 
calculated elementwise. The elements of the sym- 
metric matrix B are accessed only once. 



MMGG.. 










MMGG 10 


/*##**# 


***** 




**** 


lit ************************** 


*****/MMGG 20 


/* 










*/MM.GG, -30 


/* 


MULTIPLV TWO GENERAL MATRICES 




*/MHGG tfO 


/* 










*/MM6G 50 


/«*»»«# 


***** 




«**«*«*****«««««*«*****««*****«**/MMGG 60 1 


PROC EDUR e { A , 8 1 K , I , M , C ) , . 






MMGG 70 


DECLARE 








MMGG 80 




(A(* 


*) ,B(*,*),C(«,*)) 






MMGG 90 




BINARY FLOAT, 




/•SINGLE PRECISION VERSION 


/*S«/MMGG 100 


/■* 


BINARY FLOAT(53), 
S BINARY FLOAT(53), 




/•DOUBLE PRECISION VERSION 


/*D*/MMGG 110 
MMGG 120 




(K.,L 


M.ItJ.NJ 






MMGG 130 




BINARY FIXED, 






MMGG 140 




ERROR EXTERNAL CHARACTERd ) , . 




MMGG 150 


ERROR=»D' 






/*PPESET ERROR INDICATOR 


*/MMGG 160 


IF K 


GT 






/•TEST SPECIFieO DIMENSIONS 


*/MMGG 170 


THEN 


IF L 


GT 






MMGG leO 


Than 


IF M 


GT C 






MMGG 190 


THEN 


DC, . 

I 


=C,. 






MMGG 200 
MMGG 210 


NEXTI.. 


1 


=1+1.. 




/•COMPUTE THE I-TH ROW OF C 


*/MMGG 220 
MMGG 230 




J 


=0,. 






MMGG 240 


NEXTJ., 








/•COMPUTE THE J-TH ELEMENT 


•/MMGG 250 




J 


= JH,. 






MMGG 260 




S 


=c,. 






HMGG 270 






00 N =1 TO L,. 




/♦PERFORM SCALAR PRODUCT 


*/MHGG 2 60 






S =S+MULTIPLyUlI 


N), 




MMGG 290 






B(N,J) ,531,. 






MMGG 300 






END,. 






MMGG 310 




C(I,J) = S, . 




/•STORE RESULTANT CU.Jl 


*/MMGG 320 




IF J 


LT M 






MMGG 330 




THEN 


GO TO NEXTJ,. 




/•INCREMENT J 


•/MMGG 340 




ELSE 


IF I LT K 






MMGG 350 




THEN 


GO TO NEXTI ,. 




/*INCREMENT I 


•/MMGG 360 




ERROR=*0',. 




/•SUCCESSFUL OPERATION 


•/MMGG 370 




END, 








MMGG 380 


END, 








/•END OF PROCEDURE MMGG 


•/MMGG 390 



Purpose: 

MMGG computes the standard matrix product 
C = A • B. 

Usage: 



CALL MMGG (A, B, K, L, M, C); 



A(K, L) 
B(L,M) 
K - 
L - 

M - 
C(K,M) 



BINARY FLOAT [(53)] 

Given K by L matrix A (left-hand factor) . 

BINARY FLOAT [(53)] 

Given L by M matrix B (right-hand factor) . 

BINARY FIXED 

Given row dimension of A and C. 

BINARY FKED 

Given column dimension of A and row 

dimension of B. 

BINARY FIXED 

Given column dimension of B and C. 

BINARY FLOAT [(53)] 

Resultant K by M product matrix. 



Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error condition 
that may be detected: 

ERROR='D' means errors in specified dimen- 
sions K, L, M. Accumulation of scalar products 
is performed in double-precision arithmetic. C 
must be different from A and B. 
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Method: 



• Subroutine MMSS 



Standard multiplication means that the element Cy^ 
is the scalar product of the i-th row of A with the 
k-th column of B. 



HHSS,. 








MMSS 10 


/**««««*»«*«»***««**«»*»«**««*«««*«««*«*«*«»*«««*****«««*««««*y*««**««/lfMsj 20 1 


/* 








•/MMSS 30 


/* MULTIPLY TWO SYMMETRIC 


MATRICES STORED IN LINEAR ARRAYS 


•/MMSS 40 


/• 








•/MMSS 50 


/«t«*»«*»*«**«««**«i«**«***«**«*»«******««****««*****««*********«****«**/Hrt55 ^o| 


PROCeOURE(A,BtN,PI,. 






MMSS 70 


DECLARE 








MMSS 80 


<Ai*).ei*)tP(*.«)) 






MMSS 90 


BINARY FLOAT. 




/•SINGLE PRECISION VERSION 


/*S*/MMSS 100 


/• BINARY FL0AT(53). 




/•DOUBLE PRECISION VERSION 


/*D*/MHSS IIO 


S BINARY FL0AT(53). 






MMSS 120 


(NfLltL2.LItLK.I,KtJI 






MHSS 130 


BINARY FIXED,. 






MMSS 140 


IF N GT 








MMSS 150 


THEN 00,. 








MMSS 160 


LI, I 


-i.. 






MMSS 170 


NEXTI.. 








MMSS 180 


LK.K 


= 1,. 






MMSS 190 


NEXTK.. 








MMSS 200 


LI 


=L1,. 






MMSS 210 


L2 


=LK,. 






MMSS 220 


S 


= 0.. 




/•COMPUTE VECTOR PRODUCT OF 


TIIO*/MMSS 230 




DO J =1 TO N,. 




/•CORRESP. SUBARRAYS OF A AND B*/MMSS 240| 




S -S*MULTIPLVU(Ll), 




MMSS 250 




B(L2),53),. 






MMSS 260 




!F J LT I 






MMSS 270 




THEN LI -Ll+1,. 






MMSS 280 




ELSE LI >L1«-J,. 






MMSS 290 




IF J LT K 






MMSS 300 




THEN L2 =L2*l,. 






MMSS 310 




ELSE L2 -L2+J,. 






MMSS 320 




END,. 






MMSS 330 


PII. 


K)'S,. 




/•STORE RESW-TANT ELEMENT DF P */MMSS 340| 


IF K 


LT N 






MMSS 350 


THEN 


00.. 

LK eLK+K,. 

K =K*l,. 

60 TO NEXTK,. 

END,. 




/•INCREMENT K 


•/MMSS 360 
MMSS 370 
MMSS 380 
MMSS 390 
MMSS 400 


ELSE 


IF I LT N 






HMSS 410 


THEN 


DO,. 

LI =L1+I,. 

I =1+1,. 

GO TO NEXTI,. 

END,. 




/•INCREMENT I 


♦/MMSS 420 
MMSS 430 
MMSS 440 
MMSS 450 
MMSS 460 


END, 








MMSS 470 


END.. 






/•END OF PROCEDURE MMSS 


•/MMSS 480 



Purpose; 



MMSS computes the standard product P = A 
two symmetric matrices. 



B of 



Usage: 

CALL MMSS (A, B, N, P); 

A(N*(N+l)/2) - BINARY FLOAT [(53)] 

Given symmetric N by N matrix, 
stored in compressed form (left- 
hand factor) . 

B(N*(N+l)/2) - BINARY FLOAT [(53)1 

Given symmetric N by N matrix, 
stored in compressed form (right- 
hand factor) . 

N - BINARY FIXED 

Given order of matrices A, B, P. 

P(N,N)- BINARY FLOAT [(53)] 

Resultant N by N general product 
matrix. 

Remarks: 

Operation is bypassed in case of a nonpositive value 
of N. The symmetric matrices A and B must be 
stored in compressed form. Accumulation of 
scalar products is performed in double-precision 
arithmetic. 
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Method: 

Standard multiplication means that the element Pjjj 
is the scalar product of the i-th row of A with the 
k-th colimin of B. 



• Subroutine MMGS 











HMGS.. 






MMr.fi \ti 


/.*«„***„..„.,.„.*.**„„.„„„,*,„„„.„,,^.*.„„,„„.,.^„.^„„-- -- 


/* 






•/MMGS 30 


/* HULTIPLV & GENERAt WITH A 


SYMMETRIC MATRIX 


•/MMGS *C 


/• 






•/i«Mr,s 50 


f****f******»»****»***0****m*****m*»»^*«m*»****m*»»***m***»*****m»«*»*/titH~a'!. ad 


PROCEDURE (GtS,N,N, OPT).. 






MMGS 70 


DECCARE 






MMGS 60 


(G(*,*1»S(»I,H1HAX(N, 


Ml )) 




MMGS 90 


BINARY FLnAT, 




/•SINGLE PRECISION VERSION /* 


S^/MMGS IOC 


/* BINARY FLOATt53), 




/*DOUBLE PRECISION VERSION /< 


0*/MM6S 110 


T BINARY FL0ATt53l, 






MMGS 120 


(HtNtnM.NN,I,J,K,L.LI 


.LJ.RN.CN) 


MMGS 130 


BINARY FIXED. 






MMGS 140 


(OPT, ERROR EXTERNADCHARACTERll),. 


MMGS 150 


NN >N.. 




/•SET NN TO NUMBER OF COLUMNS 


•/MMGS 160 


HM -M,. 




/•SET MM TO NUMBER OF ROWS OF 


G*/MMGS ITC 


ERROR-'D*.. 




/•PRESET ERROR INDICATOR 


•/MMGS 180 


IF NN GT 




/•TEST SPECIFIED DIMENSIONS 


•/MMGS 190 


THEN IF M.»1 GT 






MMGS 200 


THEN DO,. 






MMGS 21C 


If 0PT='2' 






MMGS 220 


THEN DO,. 




/•IN CASE OF MULTIPL. S^G 


•/MMGS 230 


NN sMHt. 




/•INTERCHANGE NN AND MM 


•/MMGS 24C 


MM sN,. 






MMGS 25C 


END, . 






MMGS 260 


NEITK.. 






MMGS 270 
MMGS 280 


RN,CN,K«K+1,. 






MMGS 290 


00 1 =1 TO NN.. 




/•REPLACE M(«) 8V CURRENT ROW 


♦/MMGS 300 


IF OPT^'2' 




/•RESP. COLUMN VECTOR OF G 


•/MMGS 310 


THEN PN -I.. 






MMGS 320 


ELSE CN =1,. 






MMGS 330 


Hill =C(RN,CN>,. 






MMGS 340 


END,. 






MMGS 3S0 


LI, I =1,. 






MMGS 360 


NEXTI.. 




/•FOR CURRENT ROM RESP. COLUMN 


•/Mi^CS 370 


L =LI,. 




/•VECTOR COMPUTE I-TH ELEMENT 


•/MMGS 380 


T =C,. 






MMGS 390 


DO J =1 TO NN.. 




/•PERFORM SCALAR PRODUCT 


•/MMGS 4oe 


T -T»«UITIPLY(H(J) 




MMGS 410 


S<L).53»,. 






MMGS 420 


IF J LT 1 






MMGS 430 


THEN L =L*l,i 






MMGS 440 


ELSE L *L*J,, 






MMGS 450 


END,. 






MMGS 460 


IF 0PT='2' 




/•TEST SPECIFIED MULTIPL ICATinN^/MMGS ',7ol 


THEN RN =1,. 






MMGS 48C 


ELSE CN =1,. 






MMGS 490 


G(RN.CNI-T.. 




/•STORE RESULTANT ELEMENT 


•/MMGS 500 


L! =LI*I,. 






MMGS 510 


I =I+lt. 






MMGS 520 


IF I LE NN 
THEN 60 TO NEXTI,. 
ELSE IF K LT HK 
THEN GO TO NEXTK,. 




/•INCREMENT I 
/•INCREMENT ft 


MMGS 530 
•/MMGS 54C 

MMGS 550 
•/MMGS 560 


E«ROft='0',. 
END,. 
END,. 




/•SUCCESSFUL OPERATION 


•/MMGS 570 






MMGS 580 




/•END OF PROCEDURE MMGS 


•/MMGS 590 



Purpose: 

MMGS calculates G • S if OPI^'l' 
S . Gif 0PT='2' 
where G is a general and S a symmetric matrix. 

Usage: 

CALL MMGS (G, S, M, N, OPT); 

G(M, N) - BINARY FLOAT [(53)] 

Given general M by N matrix. 
Resultant product matrix G • S or 
S • G. 

S(dimension) -BINARY FLOAT [(53)] 

Given symmetric N by N or M by M 
matrix stored in compressed form in 
a one-dimensional array, lower tri- 
angular part rowwise. 

M - BINARY FKED 

Given row dimension of matrix A. 

N - BINARY FKED 

Given column dimension of matrix A . 

OPT - CHARACTER (1) 

Given option for selection of operation. 
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Remarks: 

ff no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error condition 
that may be detected: 

ERROR ='D' means errors in specified dimen- 
sions M, N. Any value of OPT different from '2' is 
treated as if it were ' 1' . 

Scalar products are accumulated in double - 
precision arithmetic. 

Method: 

Standard multiplication is performed; the general 
product is generated in the storage locations 
occupied by G. 



• Subroutine MMGT 











fiMGT.. 






MMGT 10 


/<.»««««4««*#««««««*««««*««A**«««««*n«4»««*ik«««««**««*«««**«««*i-4««««««/riMGT 20! 


/* 






"/MMGT 30 


/* 


MULTIPLY A GENERAL MATRIX 


WITH ITS TRANSPOSE 


*/MMGT 40 


/* 






•/MMGT 50 


/****** 


«««««««*«*««*#««#««« T*««4«« 


««4*4»»«««««4c««****«*«« «**«««««««« 


**/MMGT 60 


PROCeOIJRE(A,M,N,OPT,S),. 




MMGT 70 


DECLARE 




MMGT 80 




(A(«,*),S(*») 




MMGT 90 




BINARY FLOAT, 


/♦SINGLE PRECISION VERSION /* 


S*/MMGT 100 


/* 


eiNAilY f LCATI53) , 


/*OOUeLE PRECISION VERSION /* 


D*/MMGT HO 




T BINARY FLCAT(53), 




MMGT 120 




(M.N. It II t J,JJtK,L) 




MMGT 130 




BINARY fIXEO. 




MMGT 140 




(OPT.FRPCR EXTERNAL ) CHARACTER (1 ) ,. 


MMGT 150 


11 


-M, . 




MMGT 160 


JJ 


=N, . 




MMGT 170 


ERROR='D',. 


/*PRESET ERROR INDICATOR 


•/MMGT 180 


If II GT 


/*TEST SPECIFIED DIMENSIONS 


"/MMGT 190 


THEN 


IF JJ GT 




MMGT 200 


THEN 


00,. 




MMGT 210 




IF aPT='2' 


/*CHECK SPECIFIED MULTIPLIC. 


*/MMGT 220 




THEN DO,. 




MMGT 230 




JJ =11,. 


/*INTERCHANGE II AND JJ IN CASE*/HMGT 240 




II =N,. 


/"OF PRODUCT TRANSPOSE! A1«A 


♦/MMGT 250 




END,. 




MMGT 260 




L.I =1,. 




MMGT 270 


NExn.. 






MMGT 280 




K =1,. 




MMGT 290 


tsiEXTK. . 






MMGT 300 




T =C, . 




MMGT 310 




IF DPT='2' 


/"CHECK SPECIFIED MULTIPLIC. 


"/MMGT 320 




THEN DC J =1 TO JJ,. 


/*T'5ANSP0SE(A)*A IS PEfiFORMEO 


♦/MMGT 330 




T =TtMULTIPLYU(J 


1) . 


MMGT 340 




A( J ,K) ,531 , . 




MMGT 350 




END, . 




MMGT 360 




ELSE 00 J =1 TO JJ,. 


/*A*TRANSPOS€(A) IS PERFORMED 


♦/MMGT 370 




T =T+-MULTIPLY(A(I 


J) , 


MMGT 380 




A(K,J),53I.. 




MMGT 390 




ENO,. 




MMGT 400 




S{L1 =T,. 


/*SrORE RESULTANT ELEMENT S(L) 


♦/MMGT 410 




L =L+L,. 




MMGT 420 




IF K LT I 




MMGT 430 




THEN DO,. 


/"INCREMENT K. 


♦/MMGT 440 




K =Ktl,. 




MMGT 450 




GC TC NEXTK.. 




MMGT 460 




END,. 




MMGT 47C 




ELSE IF I LT II 




MMGT 480 




THEN DO,. 


/"INCREMENT I 


♦/MMGT 490 




I =1+1,. 




MMGT 500 




GC TC NEXTI,. 




MMGT 510 




ENO. . 




MMGT 520 




=^=nc=.C>,. 


/•SUCCESSFUL OPERATION 


"/MMGT 530 




END.. 




MMGT 540 


E'O, 




/*eNO OF PROCEDURE MMGT 


*/MMGT 550 


Purpose: 






MMGT calculates A • 


aT if 0PT='1' 






aT 


• A if OPT ='2' 





Usage: 

CALL MMGT (A, M, N, OPT, S); 

A(M, N)- BINARY FLOAT [(53)] 

Given M by N matrix. 
M - BINARY FKED 

Given row dimension of A . 
N - BINARY FKED 

Given column dimension of A. 
OPT - CHARACTER(l) 

Given option for selection of 

operation 
S(dimension) - BINARY FLOAT [(53)] 

Resultant symmetric product matrix, 

stored in compressed form in a 

one -dimensional array. 

Dimension is M- (M+l)/2 if OPT='l' 

and N' (N+l)/2 if OPT='2'. 
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Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The ' 
following constitutes the possible error condition 
that may be detected: 

ERROR ='D' means errors in specified dimen- 
sions M, N. Any value of OPT different from '2' is 
treated as if it were '1'. 

Scalar products are accumulated in double- 
precision arithmetic. 



• Subroutine MPRM 



Method: 



aT is 



Standard multiplication is performed; A 
symmetric M by M, while a'^ • A is symmetric 

Nby N. 





MPRM.. 


MPRM IC 
***/MPRM 2( 




/* P6RMUTE THE ROt-S OR, IF OPT = -C, THE COLUMNS OF A 


*/MPRM 3C 
♦/MPRM 40 


/* 


♦ZMPPM 50 


PROCEDUfiE(A,»'.N,T,OPT,INVJ,. mPRm In 
CECLflRE """ ®^ 


(A(*,*) ,fl J) 


MPRM 9C 


* 't"-" lioqM IOC 
,, 'J.T.ll cl-rJI.'i . /'SINGLE PRECISION VERSION /.S«/NI>R» no 


'• SIMJRY FLCAT(531, /"OOUBLE PRECISION VERSION / 
C.N.TI'I.IE.TI.UJ.IA.OI.IT) 

BISflRY FIXeP, 


*D«/MPRM 120 
MPRM 130 


(OPT, INV, ERROR EXTERNADCHiRaCIERI 11 ,. 
""^""l""'- /•PRESET ERROR INDICATOR 
{hen if » GT c '"""' SPECIFIED DIN6NS10NS 


MPRM 140 
MPRM ISO 


•/MPRM 160 


•/MPRM 170 


TH=N 00, . 


MPRM 180 


MPRM 190 


tLI^'Ic''^' m '*"" COLUMNS SHOULD BE WVED 
_,^^^ \l =^,. /,SET IE TO NUHBEP' OF COtUHNS 
IT =IE /"RESP. NUMBER OF ROMS IF NOT 


MPRM 200 
•/MPRM 210 


•/MPRM 220 


•/MPRM 230 


01.1fl=l,. 


MPRM 2*0 


IF INV='l' 


MPRM 250 


■"WcN DO,. 

M =IE,. 

IE =DI,. 

DI =-0I,. 

ENC. 

DO I =M TO IE 8Y 01,. 

^I =T(n,. /.SET TI TO Tfl) 


MPRM 260 
MPRM 270 

MPRM 280 


MPRM 29C 
MPBM 300 


MPRM 310 
MPRM 320 


•/MPBM 330 


{^JI JE I /.IS INTERCHANGE STEP NEEDED 


•/MPRM 34C 




MPRM 350 


If' Tl Gt /*IS ELEMENT OF T VALID 


«/MPRM 360 


TMEN IF T! LE IT 
THEN 00,. 


MPRM 370 
MPRM 380 


IF CPT='C' /*CHeCK SPECIFIED OPERATION 


*/MPeM 390 


/•INTERCHANGE COLUMNS I AND TI 


•/MPRM 400 


THEN 00 J =1 TO M,. 


MPRM 410 


aj =A(J,U,. 


MPRM 420 


aiJ.l)=A(j,Ti),. 


MPRM 430 


Aij,Tn=flj,. 


MPRM 440 


END,. 


MPRM 450 


/•INTERCHANGE ROWS I AND TI 


•/MPRM 460 


ELSE 00 J =1 TO N,. 


MPRM 47C 


AJ =fl(I,JI,. 


MPRM 480 


A(I,Jl=fl(TI,J,^, 


MPRM 490 


A(TI,J)=flJ,. 


MPRM 5CC 


SNOt. 


MPRM 510 


GOTO END,. 


MPRM 520 


END, . 


MPBM 53C 


^^p^ EP':OS='T'.. /*T CONTAINS INV4LI0 ELEMENTS 


*/-PHM =4C 


£N0.. 
END,. 
END, . 


MPBM 55C 


HPR« 56C 
Mt>RW 570 


^^0" /'END OF PROCEOURE .MPRM 





Purpose: 

MPRM permutes rows (if OPT='R') or columns (if 
OPT='C') of a given matrix A according to the 
permutation P (if INV='0') or its inverse P"^ (if 
INV='l'). The permutation P is given in the form 
of its transposition vector T. 

Usage: 

CALL MPRM (A, M, N, T, OPT, INV); 

A(M, N) - BINARY FLOAT [(53)] 
Given M by N matrix. 
Resultant matrix. 

M - BINARY FKED 

Given number of rows of A. 

N - BINARY FIXED 

Given number of columns of A. 

T(range) - BINARY FKED 

Given transposition vector. Its dimen- 
sion range equals M if OPT='R' and N 
if OPT='C'. 

OPT - CHARACTER(l) 

Given option specifying row or column 
permutation. 
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INV 



CHARACTER(l) 
Given oi 
tation P 
applied. 



• Subroutine MTPI 



Given option specifying whether permu- 
tation P or inverse permutation P~ is 



Remarks: 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR='D' means error in specified dimensions. 
ERROR ='T' means invalid transposition vector. 

If some element tj of T does not satisfy 1 £ ti ^ 
rai^e (Invalid transposition vector), i then the value 
of this element is interpreted as if it were equal to 
i (no interchange). 

Any value of OPT different from 'C is inter- 
preted as if it were 'R'. 

Any value of INV different from ' 1' is inter- 
preted as if it were '0'. 

Method: 

Permutation of A is performed by successively 
interchanging rows (if OPT ='R') or columns (if 
OPT='C'), i and ti for i = 1 up to range if INV='0' 
and for i = range down to 1 if INV ='1'. 
In case i = t^ no Interchange takes place. 

Mathematical Background: 

The resultant A is calculated as the product 



I ^ -I , ^ . . . L • A 
m,t m-1, t , l,t, 

m m-1 1 



if OPT='R', INV='0' 



I, . • I„ X • • • I . 'A 
l,t, 2,t„ m, t 
'1 '2 ' m 



if OPT='R',INV='r 



A • L . • L . ... I ^ 
l,tj 2,t2 n,t^ 



if OPT='C',INV='0' 



n, t n-l,t , 1, t. 

n n-1 1 



if OPT='C', INV='r 
For notational details see MPIT. 



MTPI.. 








MTPI 


IC 




»*««***«**«**««**«*«****«•«««*««• «/h>T PI 


2C 


/• 








•/MTOI 


30 


/» 


CALCULATE PERMUTATION VECTCB 


(OR ITS INVERSE IF INV ='IM 


♦/MTPI 


*C 


/* 


CORRESPCNCING TC GIVEN 


TRANS 


BOSITION VECTOfi 


•/MTPI 


5C 


/* 






^ 


•/MTPI 


60 


/***«*« 




»*«** 


**«*««««**««*««********«•«*«*«** 


•♦/MTPI 


70 


PRPCEDU'*E(T,N,INV,P),. 






MTPI 


ec 


DECLARE 






MTPI 


90 




(T(«),N,P|*I ,I,II,PI,TI 


,LN) 




MTPI 


ICG 




BINARY FIXED. 






MTPI 


lie 




UNV.ERPOP EXTERNADCHARACTE 


RID,. 


"Tpi 


12C 


I 


=C,. 






MTPI 


13C 


tl 


= 1,. 






MTPI 


1*C 


LN 


=N,. 






MTPI 


150 


IF LN GT C 




/•TEST SPECIFIED DIMENSION 


•/MTPI 


160 


THEN 


DO*. 






MTPI 


ITC 


NEXTI.. 






/♦PRESET PERMUTATION VECTOR 


♦/MTPI 


180 




I =1*1,. 




/•TO IDENTITY PERMUTATION 


•/MTPI 


190 




PI!) ■=!,. 






MTPI 


200 




IF I LT N 






MTPI 


210 




THEN GG TC NEXTI,. 






MTPI 


22C 




IF INV NE •!• 




/•SHOULD THE INVERSE PERMUTAT. 


♦/MTPI 


23C 




THEN I =1,. 




/♦VECTOR BE GENERATED 


•/MTPI 


240 




ELSE II =-II.. 






MTPI 


250 




ERROR='0',. 




/•PRESET ERROR INOICATHR 


•/MTPI 


260 


Pc".. 








MTPI 


270 




Ti =Tn)». 




/•REPLACE TI BY Till 


•/MTPI 


290 




IF TI GT C 




/♦IF II, Til IS A VALID 


♦/MTPI 


29C 




THEN IF TI LE LN 




/•TfiANSPCSITION THEN 


♦/MTPI 


3CC 




THEN DC. 




/•INTERCHANGE Pll> AND p|TII 


•/MTPI 


310 




PI -PII),. 






»'TPI 


32C 




Pin spi'^n.. 






MTOI 


330 




PITI »=PI,. 






MTPI 


34C 




GOTO STEP,. 






MTPI 


350 




EWC,. 






MTPI 


360 




ERRORs'T' f 




/♦MARK INVALID TRANSPOSITION 


♦/MTPI 


370 


STEO,. 








MTPI 


380 




I =1+11,. 






MTPI 


390 




IF I LE N 




/•HAS I ITS FINAL VALUE 


•/MTPI 


400 




THEN IF I GE 1 






MTPI 


41C 




THEN GO TO REP.. 






MTPI 


42C 




END,. 






"TPI 


*30 


ELSE 


ERR':R='C*,. 




/•ERfiCi IN SPECIFIED DIMENSION 


•/MTPI 


440 


END* 






/•END OF PROCEDURE MTPI 


♦/MTPI 


450 



Purpose: 

MTPI calculates the permutation vector if INV='0' 
and the inverse permutation vector if INV='l' from 
a given transposition vector. 

Usage: 

CALL MTPI (T, N, INV, P); 

T(N) - BINARY FIXED 

Given transposition vector. 
N - BINARY FIXED 

Given dimension of vectors T and P. 
INV - CHARACTER(l) 

Given option for selection of operation. 
P(N) - BINARY FIXED 

Resultant vector containiag the permutation 

vector of permutation or inverse 

permutation. 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR= 'D' means N is less than 1. 

ERROR='T' means T contains elements outside the 

range (1, N). 

A value of INV different from '1* is interpreted as if 
it were '0'. 
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Method: 



• Subroutine MPIT 



Vector P is preset to the identity permutation 
P=(l, . . . , N). Interchanging successively the 
components i and tj within P results in the permu- 
tation vector belonging to T if i runs from 1 up to N 
and to the inverse permutation if i runs backward 
from N down to 1. 

Mathematical Background: 

See MPrr for notation and definitions on permuta- 
tion and transposition vectors. 

The permutation vector P=(pi, . . . .Pq) corre- 
sponding to the transposition vector T = (t j^, . . . , t^) 
is defined through: 

The elementary matrices Lj^ are symmetric and 
orthogonal, that is. 



T -1 

I =1=1 
jk jk jk 



Therefore, the inverse permutation vector is 
defined by: 



I[k.qj=l, 



'h''^'V"'^\'' 



Programming Considerations: 

For valid transposition vectors it is necessary that 
1 s tj £ n for all i = 1, 2, . . . , n. As soon as a given 
transposition vector is detected nonvalid, the error 
indicator is set to T and further calculation is 
bypassed. 



MPIT.. 




MPIT 10 


/****************»**********m********»*m*mm*******»**m*******m********/HfHj 20 1 


/* 




♦/MPIT 30 


/* CALCULATE THE INVERSE PERMUTATION VECTOR OR, IF OPT « 'T*. 


♦/MPIT « 


/* THE TRANSPOSITION VECTORS 


OF THE GIVEN AND INVERSE 


♦/MPIT 50 


/« PERMUTATIONS 




♦/MPIT 60 


/* 




♦/MPIT 70 


/*******»*******m*********»:*r*»*******»*t:*****************»******m****/HPir bo 1 


PROCEDURE tP,N, OPT »PI),. 




MPIT 90 


DECLARE 




MPIT 100 


(P(*l,N,PI(*),LN,J,Pl,P2) 




MPIT 110 


BINARY FIXED, 




MPIT 120 


(OPT, ERROR EXTERNAL)CHARACTEP(l).. 


MPIT 130 


LN.J =Nt. 




MPIT 140 


IF LN GT 


/♦TEST SPECIFIED DIMENSION 


♦/MPIT 150 


THEN 00,. 




MPIT 160 


REP.. 




MPIT 170 


PI(J1=0.. 


/♦PRESET RESULTING VALUES IN 


♦/MPIT 180 


J =J-1,. 


/♦ORDER TO CHECK PERMUTATION 


♦/MPIT 190 


IF J GT 




MPIT 200 


THEN GO TO REP,. 




MPIT 210 


ERROR='P' ,. 


/♦PRESET ERROR INDICATOR 


♦/HP IT 220 


NEXTJ.. 




MPIT 230 


J =J+1,. 




MPIT 240 


PI =P(J1,. 


/♦SET PI TO PIJ) 


♦/MPIT 250 


IF PI LE LN 


/♦FEASIBILITY TEST.. 


♦/MPIT 260 


THEN IF PI GT 


/♦IS I LE PI LE N, AND IS 


♦/MPIT 270 


THEN IF PI(P1)=0 


/♦PI DIFF. FROM PREVIOUS VALUES^/MPIT 280 I 


THEN DO,. 




MPIT 290 


PI(P1)=J,. 


/♦SET Pl-TH ELEMENT OF PI TO J 


♦/MPIT 300 


IF J LT LN 


/♦HAS J ITS FINAL VALUE 


♦/MPIT 310 


THEN GO TO NEXTJ,. 




MPIT 320 


eRROR='0',. 


/♦VALID PERMUTATION VECTOR 


♦/MPIT 330 


IF OPT='T' 


/♦IF SPECIFIED THEN TRANSPOS. 


♦/MPIT 340 


THEN DO J =1 TO LN,. 


/♦VECTORS ARE CALCULATED 


♦/MPIT 350 


PI =PIJ»,. 




MPIT 360 


P2 =PIIJ»,. 




MPIT 370 


P(P2)=P1,. 




MPIT 380 


PI(P1)=P2,. 




MPIT 390 


END,. 




MPIT 400 


END,. 




MPIT 410 


END.. 




MPIT 420 


ELSE ERROR='D»,. 


/♦ERROR IN SPECIFIED DIMENSION 


♦/MPIT 430 


END,. 


/♦END OF PROCEDURE MPIT 


♦/MPIT 440 



Purpose: 

MPIT calculates the permutation vector corre- 
sponding to the inverse of a given permutation if 
OPT='I' and the transposition vectors of the given 
permutation and of its inverse if OPT='T'. 

Usage: 

CALL MPIT (P, N, OPT, PI); 

P(N) - BINARY FKED 

Given permutation vector of given 

permutation. 

Resultant transposition vector of given 

permutation if OPT='T'; otherwise, 

unchanged. 
N - BINARY FIXED 

Given dimension of vectors P and PI. 
OPT - CHARACTER(l) 

Given option for selection of operation. 
PI(N) - BINARY FKED 

Resultant permutation vector of inverse 

permutation if OPT='r or transposition 

vector of inverse permutation If OPT='T'. 



Remarks: 

If no errors are detected In the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR= 'D' means N is less than 1. 
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ERROR ='P' means given permutation vector P is 
not a valid permutation vector. A value of OPT 
different from 'T' is treated as if it were 'T'. PI 
cannot coincide with P in case OPT='I'. 

Method: 

In case OPT='r as well as OPT='T' the first step 
is calculation of the inverse permutation vector PI 
combined with a check on the feasibility of given 
permutation vector P. 

If OPT='T' a second step is performed which 
replaces the permutation vectors by the corre- 
sponding transposition vectors simultaneously. 

Mathematical Background: 

Elementary matrices 1 \^] 

The elementary matrix Ij^ is obtained from the 
identity matrix I by interchanging rows k and 1. 
Multiplication of a matrix A on the left by an Ijq of 
compatible dimensions results in an interchange of 
rows k and 1 of A, while multiplication on the right 
interchanges columns k and 1. An interchange of 
two elements is also called a transposition. Note 
that \i is symmetric and orthogonal: 

_ T _ -1 

^ " ^ ~ ^1 



Permutation vector 

Let N* denote the set of integers {l, 2, . . . , n}. A 
permutation is a one-to-one function that maps N* 
onto N*. It is fully described by the ordered 
n-tuple (si, Sg, • . . , Sji) called a permutation vector, 
where s^ e N* is the function value corresponding to 
argument i e N*. Applying the permutation 

(S]^ Sjj) on the rows of the n by n identity 

matrix I results in an orthogonal matrix l[k, sjj. 
The notation indicates that the k-th row is identical 
with the S]j-th row of I for all k = 1, 2, , . . , n. 

If an n by n matrix A is multiplied on the left by 
l[k, S]J, its rows get permuted according to the 
permutation vector (sj, S2, • • • , Sjj). 

Permutation of columns is similarly performed 
multiplying by the permutation matrix 
iTjk, sj^]= I[sj^, k] on the right-hand side. 

Transposition vector 

An n-term product In, tj^ • In-1, tn-i" • • ^l, tj cor- 
responds uniquely to a permutation matrix l[k, sj^]. 
The ordered n-tuple (t^, tg, • . . , t^), which fully 
describes the above transposition product, is 



called a transposition vector. The correspondence 
between permutation vectors and transposition 
vectors is not one to one: a given permutation 
vector (si, S2, . . . , s^ corresponds to several dif- 
ferent transposition vectors if n > 2. A uniquely 
determined transposition vector is obtained under 
the additional restriction tj s i. 

The transposition vector comes in naturally when 
pivoting is used with Gaussian elimination technique. 
K, at the j-th elimination step, rows j and tj must 
be interchanged for j=l, . . . , n, then (ti, t2, . . . tjj) is 
the transposition vector of the permutation that was 
applied to the rows of the original matrix. This 
transposition vector is uniquely determined since 
tj Si. 

Permutation vector of the inverse permutation 

The inverse P"-*- of a permutation P = (p^, . . . , p^) 
has function value i corresponding to argument p^. 
Let Q = (qj, . . . , q^) be the permutation vector of 
P"-*^. I [k, pjj] is orthogonal — that is, 
I"^ [ k. Pkl = I^ [k. Pk] • Therefore, I [k, q^] 
I [Pk, k] . Since I [k, q^] = I [pj^, qpj^] , it 
follows by comparison qpj^ = k. 

Transposition vector of permutation 

The calculation of the transposition vector T = (tj, 
t2, • • . , tji) corresponding to the permutation 
vector P = (Pj, P2, . . • , Pn) is based on the identity 

I[k, Pk] • li, qi=I [k, Pk'] (1) 

with P '= (pi', .... PnO = (Pl Pi-1. i. 

Pi + 1' •••' Pqi-1' ^i' Pqi + l' •••' V 

Applying identity (1) successively for i = 1, 2, . . . , 
n leads to 

I [k, Pk] • Ii, ti* I2,t2--- Vtn=I 
or 

I [k. Pk] =In,tn- In-l,tn-i--- \ t2 * 
Il.ti 

It is interesting to note that combining the calcula- 
tion of transposition vectors of P and P"^ greatly 
improves the efficiency. 

Programming Considerations: 

The check on validity of the given permutation vec- 
tor is performed so that all components of the 
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vector PI are preset to zero. At the i-th step of the 
calculation of the inverse permutation vector, Pi is 
checked for 1 s p^s n, and qp^ is checked for zero. 
If both restrictions are met qpj is reset to i. Other- 
wise, the error indicator is set to 'P' and further 
calculation is bypassed. 



Linear Equations and Related Topics 
• Subroutine MFG 















MFG.. 






MFG 


10 




li««««*»«««**«**«««««««****««4**4iS«««»««««*««*«*«**« **#*««««««*«««« 


«*/MFG 


20 










• /MFG 


30 






FACT0RI2E A GENERAL NON-SINGULAR MATRIX A INTO A PRCOUCT 


«/MFG 


40 






OF A L0WEt< TRIANGULAR MATRIX 


L AND AN UPPER TRIANGULAR 


*/MFG 


50 






MATRIX U OVERWRITTEN ON A, OMITTING UNIT DIAGONAL OF U 


• /MFG 


60 










• /MFG 


70 


/*««««*««*««*«*««»*««»«»**««««**«*«** «*«*««*«««««t,4,«««*««««*««*«**C« 


••/MfG 


30 




PfiOCEDUREtA,IPER,N.EPS),. 




MFG 


90 




DECLARE 




MFG 


100 






ERROR EXTERNAL CHARACTER(l), 


/*EXrERNAL ERROR INDICATOR 


• /MFG 


110 






EPS BINARY FLOAT, 




MFG 


120 






M BINARY FL0ATI53), 




MFG 


130 






(AC*,*) ,H,R) 




MFG 


l-iO 






BINARY FLOAT, 


/*SINGLE PRECISION VERSION /* 


S*/MFG 


150 


1 /• 


BINARY FL0AT(53I, 


/•DOUBLE PRECISION VERSION /• 


D«/MFG 


160 






(IPER(«),I,IND,J,K,L.LN.M,Nt 




MFG 


170 






BINARY FIXED,. 




MFG 


180 




LN 


=N,. 




MFG 


190 




IF 


LN LE 


/•TEST SPECIFIED DIMENSION 


• /MFG 


2C0 




THEN 00,. 




MFG 


310 






EftROR='P' ,. 


/*P MEANS WRONG PARAMETER 


• /MFG 


220 






GO TO RETURN.. 




MFG 


230 






END,. 




MFG 


240 




ERROR='0',. 


/♦PRESET ERROR INDICATOR 


*/MFG 


250 








/»*** **1i»it» t ********* ********* 


**/MFG 


26C 






DO L =1 TO LN,. 


/•CALCULATE SCALING FACTORS 


*/MFG 


270 






R =0,. 


/*«««««**•*««****«*«««««««*««> 


••/MFG 


280 






00 J =1 TO LN,. 


/•COMPUTE ABSOLUTELY GREATEST 


*/MFG 


290 






H =A8S(A(L,J1),. 


/•ELEMENT R IN EACH ROW OF A 


*/MFG 


300 






IF H GT R 




MFG 


310 






THEN F =H,. 




MFG 


320 






END,. 




MFG 


33C 






If R = 


/•TEST FOR ZEROS IN ANY ROW 


• /MFG 


340 






THEN DO,. 




MFG 


350 






ERRORs'S't. 


/•ANY ROW IN GIVEN MATRIX A 


• /MFG 


360 






GO TO RETURN,. 


/«IS ZERO 


•/MFG 


370 






END,. 




MFG 


380 








/•STORE R IN AN INTEGER VECTOR 


*/MFG 


390 






ELSE UNSPECUPER(Ln=UNSPEC(PI.. 


MFG 


400 






END,. 


/ **********m****************** 


«*/MFG 


410 








/•GAUSS ELIMINATION 


•/MFG 


420 






00 L =1 TO LN,. 


/ **m************************** 


••/MFG 


430 






UNSPEC(M)='1'B,. 


/•PRESET M AS SMALLEST INTEGER 


• /MFG 


4^0 






DO J =L TO LN,. 


/•MODIFY COLUMN, SEARCH PIVOT 


«/MFG 


450 






W,H =A(J,L1,. 


/•SAVE ELEMENT 


*/MFG 


46C 






00 K =1 TO L-l,. 


/•COMPUTE SCALAR PRODUCTS 


«/MFG 


470 






W =W-MULTIPLY(A( J,K),AtK,L»,53),. 


MFG 


480 






END,. 




MFG 


490 






At J,LI=W,. 


/•UPDATE ELEMENT 


•/MFG 


50C 






W =ABS(W»,. 




MFG 


510 






UNSPEC(n=UNSPECIW»,. 




MFG 


520 






I =I-IPER(J».. 


/'DIFFERENCE OF EXPONENTS 


*/MFG 


5 30 






IF I GT M 


/*SEARCH FOR LARGEST 9IFFERENCe«/MFG 


54C 






THEN DD,. 




MFG 


550 






I NO =J,. 


/*STORE ROW-INOEX 


*/MFG 


560 






» =1,. 




MFG 


5 70 






R =H,. 


/*SAVE ORIGINAL ELEMENT FOR 


• /■-FG 


5 80 






END,. 


/*TEST ON LOSS OF SIGNtFtCANCE 


*/MFG 


590 






END,. 




MFG 


6C0 






IF IND GT L 


/•IS INTERCHANGE NECESSARY 


*/MFG 


6lo 






THEN 00,, 




MFG 


62C 






IPEH1IN0»=IP£R(L),. 


/*RFSTCRE PERMUTATION VECTOR 


*/MFG 


630 






00 J =1 TO LN,. 


/•INTERCHANGE ROWS CF MATRIX A 


*/MFG 


fc'fC 






H =A1L.JI,. 




MFG 


650 






A(L,J)=A(IN0,J),. 




MFG 


660 






A{IND,J)=H,. 




MFG 


67C 






END,. 




MFG 


680 






END, . 




MFG 


69C 






I''ER(L)=INO,. 


/*STORE ROW NUMBER 


• /MFC 


700 






H =A(L,L),. 


/*H CONTAINS THE PIVOT 


*/MFG 


710 






IF flf^SfHI LE AeStEPS«R) 


/•TEST PIVOT ELEMENT FOR LOSS 


*/MFG 


720 






THEN IF H NE C 


/*0F SIGNIFICANCE AND FOR ZERO 


• /MFG 


730 






THEN ERROR=«W»,. 


/*W MEANS WARNING 


*/MCG 


7^,0 


j 




ELSE [F R = C 


/•IS ORIGINAL ELEMENT ZERO 


*/MFG 


750 






TH^N 00,. 




MFG 


760 






ERRPR='S' ,. 


/•CALCULATED PIVOT AND ^hE 


*/M = G 


770 






GO TO RETURN,. 


/•ORIGINAL ELEMENT AOE ZESQ 


*/MFG 


780 






END,. 




MFG 


790 






ELSE 00 , . 


/•CORRECT ZERO PIVOT 


*/MFG 


80C 






H =3*lE-7,. 


/•SINGLE PRECISION CORRECTION 


*/MFG 


810 


/« 




H =R*lE-lfc,. 


/* DOUBLE PRECISION CORRECTION 


*/MFG 


820 






ERROR='C' ,. 


/•WARNING ANO CORRECTIHW 


• /MFG 


83C 






END, . 




M^G 


840 






00 J =L*1 TO LN,. 


/•EXECUTE LOOP OVER L-TH ROW 


*/MFG 


350 






■ w =C,. 




^*FG 


860 






DO K =1 TO L-l,. 


/•CALCULATE SCALAR "^jgrnjcTS 


»/MFG 


870 






M =W+HULTIPLY(A(L,K) , At K, J ) ,53 ) , . 


MFG 


fl8C 






ENO,. 




MFG 


890 






A(L, J)=(A(L,J)-H1/H,. 


/•COMPUTE NEW ELEMENT 


*/MFG 


900 






END,. 




MFG 


910 






ENO,. 




MFG 


920 


RETURN 






MFG 


93C 




END 




/•END OF PROCEDURE MFG 


*/MFG 


940 



Purpose: 

MFG factorizes a general nonsingular matrix A 
into a product of a lower triangular matrix L and 
an upper triangular matrix U overwritten on A, 
omitting the unit diagonal of U, 
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Usage: 

CALLMFG (A, IPER, N, EPS); 

A(N,N)- BINARY FLOAT [(53)] 

Given two-dimensional array. 
Resultant calculated triangular 
factors L and U, where unit diagonal 
of U is not stored. 

IPER(N) - BINARY FKED 

Resultant vector containing the per- 
mutations of rows of the matrix. 

N - BINARY FKED 

Given order of matrix A. 

EPS - BINARY FLOAT 

Given relative tolerance for test on 
loss of significant digits. 



all ones, which are not stored. The given matrix 
A Is overwritten by the resulting triangular factors 
L and U, omitting the unit diagonal of U. 

For reference, see: 

H.J. Bowdler, R. S. Martin, G.Peters, J.H. 
Wilkinson, "Solution of Real and Complex Systems 
of Linear Equations", Numerische Mathematik , 
Vol. 8, 1966, pp. 217-234. 

A. Ralston and H.S. Wilf, Mathematical Methods 
for Digital Computers , Vol. 2, 1967, pp. 69-71. 

Mathematical Background: 

Let A be a nonsingular real matrix of order n. In 
general, it can be factorized into a product 



Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR = 'P' means error in specified dimension 
NsO 

ERROR = 'S' means that any row in the given 

matrix A is zero or that any calcu- 
lated pivot and the corresponding 
original elements are zero; this 
implies that the given matrix A is 
singular. 

ERROR = 'G' indicates correction. Any calculated 
zero pivot is modified to R* 10""^ in 
single precision (R« 10-16 in double 
precision if the correspondii^ 
original element R is nonzero). 

ERROR = 'W indicates a warning. A possible 
loss of s^ificance may occur. 

If at any factorization step the calculated pivot is 
equal to zero, the corresponding original element 
R is tested for zero. The given matrix A is inter- 
preted as being singular if R is zero. MFG sets 
error indicator ERROR to 'S' and further calcula- 
tion is bypassed. If R is not zero, pivot is cor- 
rected to R" 10-"^ (in double precision R« 10~^^ and 
ERROR is set to 'G'. 

Method: 

Calculation of the triargular factors L and U is done 
using the standard Gaussian elimination technique. 
Columnwise pivotingis builtin, combined with scaling 
of rows (equilibration). The upper triangular ma- 
trix U is normalized so that the diagonal contains 



A = L • U 

where L and U are lower and upper triai^ular 
matrices respectively; U is chosen so that it has a 
unit diagonal. 

The elements Ijj^ and u^ of the factor matrices L 
and U are computed using the following recursive 
formulas: 



k-1 

1., = a., - 2_< 1 • u 
ik ik j^j im mk 




.N 



, 1 



i-1 



m=l 



11 




Programming Considerations: 

Even if the given matrix A is nonsingular and well 
conditioned, the process can fail when a leading 
principal submatrix of A is singular; furthermore, 
the process is numerically unstable whenever a 
leading principal submatrix is ill conditioned. 

hi order to avoid these inconveniences, a tech- 
nique of partial pivoting with an equilibration of the 
matrix has been introduced in MFG. Initially, the 
element with greatest absolute value ~ say. 
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Wj (i=l, 2, . . . , N), of each row of A is computed. 
The scaling factors Wj are used as weights for 
pivoting. 

The p-th factorization step is as follows: 

1. Computation of the p-th column of L: 



p-1 

1. = a. - 2 1. • u 
iP ip ^j im mp 



and overwrite 1. on aj (i = P, P+1, . . . , N) 



• Subroutine MFS 



2. Equilibrated partial pivoting: 
Choose k so that 



w. 



MAX 
isp 



W. 



Store the integer k in the vector IPER and, 
if k > p, interchange the k-th and p-th^rows. 
Then 1 is the next pivot. 

irir 

3. Computation of the p-th row of U: 



u . 



pi 1 



(a 



PP 



Pi 



P-1 
m=l 



pm 



u .) 

mr 



and overwrite Up. on a . (1 = pH, pf2, . . , , N) 

The diagonal terms of U, which are 1, are not 
stored. For economy of storage, the scaling 
weights Wj are initially stored in the vector IPER. 
This is done using the PL/I function UNSPEC, 
which stores Wj in internal coded representation. 
This allows substitutingjsubtractionsfor divisions 
in the choice of pivots. 

If at factorization step p the pivot L becomes 
zero, the corresponding original element app Is 
tested for zero. The given matrix A is interpreted 
as being singular if app is also zero. MFG sets 
error indicator ERROR to 'S' and further calcula- 
tion is bypassed. In other cases zero pivot is 
modified to: 



_7 
10 in the single precision 



1 = a * 
PP PP 



version 



10' 



•16 



in the double precision 
version 



MFS.. 






«FS 


IC 


/***e*<t 


♦ **««#****«*» ***s**»<.***#**ftt 


«*****♦****«»«♦«*»♦**#***** ft**** 


♦♦/MFS 


20 








♦ /MFS 


3C 




FACTORIZE SYMMETRIC POS 


ITIVE DEFINITE MATRIX 


♦ /MFS 


40 








♦ /MFS 


50 


/***♦** 


****** *:********I|.**I|.«***«;****« 


******************************** 


♦♦/MFS 


60 


PROCEDJREIA.N.EPS) ,. 




MFS 


70 


DECLARE 




MFS 


80 




ERROR EXTERNAL CHARAC TER 1 1 ) , 


/*EXTERNAL ERROR INDICATOR 


♦/MFS 


90 




GPS BINARY FLOAT, 




MFS 


100 




SUM BINARY FLOAT) 53), 




MFS 


no 




A(*) 




MFS 


120 




BINARY FLOAT, 


/*SINGLE PRECISION VERSION /* 


S^/MFS 


130 


/* 


BINARY FL0AT(53) , 


/*DCU9LE PRECISION VERSION /* 


0*/MFS 


1*0 




( IN0,I6,K,KL ,L,N) 




MFS 


150 




BINARY FIXED,. 




MFS 


16-^ 


IF H 


LE C 


/*TEST SPECIFIED DIMENSION 


♦ /MFS 


ITO 


THEN 


on,. 




MFS 


18C 




ERRQR='P' ,. 


/*P MEANS WRONG PARAMETER 


♦ /MFS 


190 




GO TO RETURN,. 




MFS 


200 




END,. 




MFS 


210 


ERROR='0',. 


/♦PRESET ERROR INDICATHR 


♦ /MFS 


22C 


INO 


=0,. 


/'INITIALIZE ROW-LOOP 


♦ /MFS 


230 


18 


= 1.. 




MFS 


240 




DO K =1 TO N,. 


/♦EXECUTE LOOP OVER ALL ROWS 


♦ /MFS 


250 




KL =C,. 




MFS 


260 


LOOP.. 




/♦PERFORM LOOP WITHIN K-TH ROW 


♦ /MFS 


270 




SUM =C-,, 




MFS 


280 




DO L =IB TO INO,. 


/♦CALCULATE SCALAR PRODUCT 


♦ /MFS 


290 




KL =KL*1,. 




MFS 


300 




SUM =SUMtMULTIPLY(A(LI 


,A(KL),531,. 


MFS 


310 




END,. 




MFS 


320 




KL =K1_+1,. 




MFS 


330 




INO =INOtI,. 




MFS 


340 




SUM =A(INDI-SUM,. 




MFS 


350 




IF IND GT KL 


/♦IS AIIND) ON DIAGONAL 


♦ /MFS 


360 




THEN DO,. 




MFS 


370 




A(1N0)=SUM/A(KL» ,. 


/♦CALCULATE NON-DIAGONAL TERM 


♦ /MFS 


380 




GO TO LOOP,. 




MFS 


390 




END, . 




MFS 


400 




IF SUM GT 


/♦TEST SIGN OF RAOICAND 


♦ /MFS 


410 




THEN DO,. 


/♦POSITIVE RADICAND 


♦ /MFS 


420 




IF SUM LE ABS(EPS*A(INCJ)/*rEST ON LOSS OF SIGNIFICANCE 


♦ /MFS 


430 




THEN ERROR='H',. 


/*W MEANS WARNING 


*/MFS 


440 




A( INO)=SQPT(SUM),. 


/♦CALCULATE NEW DIAGONAL TERM 


♦ /MFS 


450 




END,. 




MFS 


460 




ELSE DC,. 


/♦NEGATIVE RAOICAND 


♦ /MFS 


470 




Er^OR=*S',. 


/♦S MEANS MATRIX A IS NOl 


•/MFS 


48C 




N =K-1,. 


/♦PGSIIIVE DEFINITE 


♦/MFS 


490 




GO TO RETURN,. 


/♦REDUCE DIMENSION OF LOWER 


♦ /MFS 


500 




END. . 


/♦TRIANGULAR FACTOR 


♦ /MFS 


510 




IS =IB+K,. 




MFS 


520 




END,. 




MFS 


530 


RETURN. 






MFS 


540 


END, 




/♦END Of PRDCEOORE MFS 


♦ /MFS 


550 



Purpose: 

MFS computes a triangular factorization of a sym- 
metric positive definite matrix using the square root 
method of Cholesky. 

Usage: 

CALL MFS (A, N, EPS); 



A(N*(N+l)/2) 



N- 



EPS- 



Remarks: 



BINARY FLOAT [(53)] 
Given one-dimensional array con- 
taining the matrix A stored row- 
wise in compressed form. 
Resultant calculated lower triangular 
factor T stored rowwise in com- 
pressed form. 
BINARY FKED 
Given order of matrix A. 
Resultant order of the triangular 
factor T. 
BINARY FLOAT 

Given relative tolerance for test on 
loss of significant digits. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The ' 
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following constitutes the possible error conditions 
that may be detected: 

ERROR= 'P' means error in specified dimension: 

N^ 
ERROR='S' means given matrix A is not positive 

definite, possibly because of severe 

loss of significance. 
ERROR='W' is a warning. A possible loss of 

significance could occur. 

The lower part of the given symmetric matrix, A, 
is assumed to be stored in compressed form ~ that 
is, rowwise in N*(N+ l)/2 successive storage lo- 
cations. On return the lower triangular factor T is 
stored in the same way. 

Method: 

Factorization is done using the square root method 
of Cholesky, which generates a lower triangular 
factor matrix T such that 



The determinant of A may be eomputed by the 
formula: 



N 
det(A) = 77 
k=l 



^1, 



Programming Considerations: 

The given sjrmmetric matrix A is assumed to be 
stored in compressed form. The resultant lower 
triangular factor T is returned in the locations of A. 

If at factorization step k (k=l, 2, . . . , N) the 
radlcand is not positive , the error parameter 
ERROR is set to 'S', N to k-1, and further calcula- 
tion is bypassed. 

The error parameter ERROR is set to 'W if any 
calculated radlcand f = r - SUM is not greater than 
I EPS • r I , where r is the original diagonal term 
and SUM a scalar product sum. 

It should be noted that Cholesky factorization is 
done without pivoting. 



T • transpose (T) = A 

The given matrix. A, is replaced in core by the 
resultant matrix, T. 

For reference, see: 

J. H. Wilkinson, The Algebraic Eigenvalue Prob- 
lem . Clarendon Press, Oxford, 1965. 
ATRalstonandH.S. Wilf, Mathematical Methods 
for Digital Computers , Vol. 2, 1967, pp. 71-72. 

Mathematical Background: 

The elements t.. of the lower triangular matrix T 
are computed using the following recursive 
formulas: 



kk 



*ik = 




m=l 



*kl 



l = k+l, ..., N, k = l, ..., N 

i 

( ^ is to be Interpreted as zero when j < 1. ) 
m=l 
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• Subroutine MFSB 



MFSB.. 








MFSB 10 




■»«*««4:*4i*iK*«4:*««:«4 


******#****.»***»«***,**,,.»,**»»»»/HFSB 20 ] 


/* 








•/MFS6 30 


/* FACTORIZE 


A GIVEN POSITIVE 


DEFINITE N BY N MATRIX A 


*/MFSe *0 


/* WITH 


SYMMETRIC BAND STRUCTU 


'E (NUD UPPER COOIAGONALSl 


♦/MFSB 50 


/* 








♦/MFSB 60 


/«>(it#**«*V«* 


#«:V4!«4:**««:«4««* ««#««««« 


****!**9****#*****************ti*** 


•♦/MFSB 70 


PROCEDUREf A,N, 


NUD,EPS),, 




MFSB 80 


DECLARE 








MFSB 90 


ERROR EXTERNAL CHARSCTERU) 


/♦EXTERNAL ERROR INDICATOR 


♦/MFSB 100: 


EPS 


iflNAR 


Y FLOAT, 




MFSB 110 


SUM 


BINARY FLnAT(53) , 




MFSB 120 


(Al* 


.*),PIV) 




MFSB 130 


BINARY FLOAT, 


/*SINGLE PRECISION VERSION /» 


S«/MFSB 140 


/* BINARY FLPAT(53), 


/♦DOUBLE PRECISION VERSION /« 


D»/MFS6 150 


(I,ID,J,JENO,K,KK,KEND, 




MFSB 160 


LN,LNUD,M 


,N,NC,Nft,NUD) 




MFSB 170 


BINARY FIXED,. 




MFSB 180 


LN ^N,, 








MFSB 190 


LNUO =NUD 








MFSB 200 


ERRCRs'P' 






/*P MEANS MRONG PARAMETER 


♦/MFSB 210 


IF LNUO LT 




/♦TEST SPECIFIED NUMBER OF 


*/MFSe 220 




/♦UPPER CODIAGONALS 


♦/MFSB 230 


IF LN LE 


LNUD 




/♦TEST SPECIFIED DIMENSION N 


♦/MFSB 240 


THEN GO TO ^ETU'^N, . 




MFSB 250 


NR =l.N- 


LNUO, 




/♦INITIALIZE PARAMETERS 


♦/MFSB 260 


NC,JEND=LNUD+1 


. 




MFSB 270 


DO I 


=1 TO LN,. 


/♦EXECUTE LOOP OVER ALL ROMS 


*/MFS9 280 


IF I 


GT NR 


/♦MODIFY JEND AT THE END OF 


♦/MFSB 290 


THEN 


JEND 


=JEN0-1,. 


/♦THE BAND STRUCTURE 


♦/MFSB 300 


KENO 


= NC, 




/♦INITIALIZE KENO AND H 


♦/MFSB 310 


M 


=NC- 


.. 




MFSB 320 


IF M 


GT C 




/♦MODIFY KEND AT THE START OF 


♦/MFSB 330 


THEN 


KtND 


=KEND-H,. 


/♦THE BAND STRUCTURE 


♦/MFSB 340 




DO J 


=1 TO JEND,, 


/♦EXECUTE LOOP OVER I-TH ROW 


♦/MFSB 350 




10 


=J-1,. 


/♦CALULATE INCREMENT tD 


*/MFSB 360 




KK 


= !,. 


/♦INITIALIZE KK AND SUM 


♦/MFSB 370 




SUM 


= 0,, 




MFSB 380 






no K =Jtl TO KENO 


. /♦COMPUTE SCALAR PRODUCT SUM 


*/MF5B 390 






KK =KK-1,. 




MFSB 400 






SUM =SU«+MULT!PLY{A(KK,K),A(KK,K-rD),53),. 


MFSB 410 






END,. 




MFSB 420 




SUM 


=A(I,J)-SUM,. 




MFSB 430 




IF J 


= I 


/♦IS fl(I,J) DIAGONAL ELEMENT 


♦/MFSB 440 




THEN 


IF SUM GT C 


/♦TEST FOR LOSS OF SIGNIFICANT 


♦/MFSB 450 




THEN 


DO,. 


/♦DIGITS AND COMPUTE NEW TERM 


♦/MFSB 460 






IF SUM LE AeS{EPS*A(!,Jll 


MFSB 470 






THEN ERRnR='W',. 




MFSB 480 






PIV,A(I,J)=SORT(SUMI,. 


MFSB 490 






END,. 




MFSB 500 




ELSE 


00,. 




MFSB 510 






ERROP='S',. 


/♦A IS NOT POSITIVE DEFINITE 


♦/MFSB 520 






N =1-1,. 


/♦RESET INPUT DIMENSION N 


♦/MFSe 530 






GO TO RETURN,. 




WFSB 540 






END,. 




MFSB 550 




ELSE 


Ad ,J» = SUM/PIV,. 


/♦MODIFY NON-DIAGONAL ELEMENT 


♦/MFSB 560 




IF J 


LE M 




MFSB 570 




THEN 


KENO =KENOtl, . 


/♦UPDATE KEND IF NECESSARY 


♦/MFSB 58G 




END, 






«FS6 590 


END. 








MFSB 6CC 


EPROR='C' 






/♦SUCCESSFUL OPERATION 


♦/MFSB 610 


RETURN.. 








MFSB 620 


END,. 






/♦END OF PROCEDURE MFSB 


♦/MFSB 630 



Purpose: 

MFSB computes a triangular factorization of a S3mi- 
metric positive definite band matrix using the 
square root method of Cholesky. 

Usage: 

CALL MFSB (A, N, NUD, EPS); 



A(N, NUEH-1) 



N 



BINARY FLOAT [(53)] 
Given two-dimensional array con- 
taining the upper part of a S3an- 
metric band matrix A with NUD 
upper codiagonals. 
Each row starts with its diagonal 
element. 

Resultant calculated upper band 
factor T. 
BINARY FIXED 

Given number of rows of matrix A. 
Resultant number of rows of upper 
band factor T. 



NUD 



EPS 



BINARY FIXED 

Given number of upper codiagonals 

of A. 

BINARY FLOAT 

Given relative tolerance for test 

on loss of significant digits. 



Remarks: 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR='P' - means error in specified dimen- 
sions: 
NUD< or N s NUD 

ERROR='S' - means any calculated pivot is not 
positive — that is, given matrix A 
is not positive definite. This is 
possibly due to a severe loss of 
significance. 

ERROR='W' - is a warning indicating possible loss 
of significance. 

The upper part of symmetric band matrix A, con- 
sisting of the main diagonal and NUD upper co- 
diagonals, is assumed to be stored rowwise in 
array A(N, NUDU) starting with its diagonal ele- 
ments. Thus, A(i, 1) are the diagonal elements of 
the given band matrix A (i = 1, 2, . . . , N). On re- 
turn, the upper band factor T is stored in the same 
way in the locations of A. 

Input parameters N and NUD should satisfy the 
following restrictions: 

<■ NUD < N 

Method: 

Factorization is done using the square root method 
of Cholesky. This generates the upper band factor 
T such that 

T • transpose (T) = A 

The given A is replaced by the resultant T. 

For reference see: 

H. Rutishauser, "Algorithmus 1 -Lineares 
Gleichungssystem mit ssrmmetrischer positiv- 
definiter Bandmatrix nach Cholesky", Computing 
(Archives for Electronic Computing), Vol. 1, iss. 
1, 1966, pp. 77-78. 
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Mathematical Background: 

For the elements aj, of a symmetric band matrix 
with NUD upper codiagonals, the following is true: 

ajt = if I i - k I > NUD 

The elements tjj^ of the upper factorized matrix T 
are computed using the following recursive 
formula: 



*ik = 



t.. 
11 



i-1 



^ik- D 



m=mo 



mi 



mk 



greater than | EPS • r | , where r means the 
original diagonal term and SUM a scalar product 
sum. 

The input parameters N and NUD must satisfy 
the restriction: 

0^ NUD< N 

Otherwise, ERROR is set to 'P'. 

It should be noted that Cholesky's factorization 
is done without pivoting. 



m = max (1, k-NUD) i = l, 2, ..., N 
k = i+l, ... , 
min (i + NUD, N) 



(any symbol Tj X is to be interpreted as 
m=mo 

zero if r < m ) 

hi the special case i = k (diagonal elements) , the 
above equation may be written: 



*kl. 




k =1, 2, , , , , N mo = max (1, k-NUD) 

The resultant upper factor T has band structure 
again, because the following is true: 

t., = if k > i + NUD 

ik 

Programming Considerations: 

The upper part of the symmetric positive definite 
band matrix A, consisting of the main diagonal and 
NUD upper codiagonals, is assumed to be stored 
rowwise in the two-dimensional array A(N, NUD+ 1) 
such that A(i, 1) are the diagonal elements (i = l, 2, 
. . . , N). Therefore, the elements A(i, k) of array 
A with i+k> N are irrelevant; they are not touched 
within MFSB. The resultant upper band factor T is 
returned in the locations of A. 

If, at factorization step m(m = l, 2, ..., N), the 
radicand is not positive, error parameter ERROR 
is set to ' S' , dimension N to m - 1, and further 
calculation is bypassed. 

The error character is set to 'W if any calculated 
radicand f =r- SUM is positive but no longer 
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• Subroutine MFGR 



Purpose: 



MFGR. . 




MFGR 10 


/««««**««««««:««»«»*« *«««««**«*«««««« 


«*4:*««*«****««*»**«:««4i;<««:««*«««« 


**/MFG'' 2C 








*/MFGR 30 




FOR A GIVEN M 6Y N MATRIX A 


THE FOLLOWING CALCULATIONS 


♦ /•«FGR 40 




ARE PERFORMED 




♦ /MFGO 50 




11} DETERMINE RANK AND LINEAPLY tNOEPENDENT ROWS AND 


♦/MFGR 60 




COLUMNS (BASIS) 




♦/l*FGft 70 




12) FACTORIZE A SUBMATRIX Of 


MAXIMAL RANK 


♦/MFGR 80 




(3) EXPRESS NON-BASIC ROWS IN TERMS OF BASIC ONES 


♦/MFGR 90 




(4) EXPRESS BASIC VARIABLES 


IN TERMS OF FREE ONES 


♦/MFGR 100 








♦/MFGR 110 


/**♦*«***»«***»***;**#*««**»##***#*** 


*«4«*««««*«***«***«*4:*«r44r««««*«4. 


•♦/MFGR 120 




PROC£OURElA,M,N,EPS,IRANK,IROW,ICrL),. 


MFGR 130 




DECLARE 




MCGR lAO 




ERROR EXTERNAL CHARACTERU ) , 


/*EXTERNAL ERROR INDICATOR 


♦/MFGR 150 




EPS BINARY fLOAT, 




WFGR 160 




SUM BINftRY FlOAT(53), 




MFGR 170 




( A( *,*), HOLD, PI V, SAVE ,TOL, WORK) 


MFGR 180 




BINARY FLOAT, 


/♦SINGLE PRECISION VERSION /* 


S^/MFGR 190 


/* BINARY FL0AT(53), 


/♦DOUBLE PRECISION VERSION /* 


D^/MFGR 200 




(ICOLI*),IROH(*) ,I,ICtIR. 




MFGR 210 




INO,IRA^K, J,K,LM,LN,M,N) 




MFGR 22C 




eiNARY FIXED,. 




M^GR 230 




LM =M,. 




MFGR 240 




LN =N,. 




MFGR 25C 




ERROR=*P't . 


/*P MEANS WRONG INPUT 


♦/MFGR 260 




IF LM LT 1 


/*TEST OF DIMENSION M 


*/MFGR 270 




THEN GO TO RETURN,. 




MFGR 280 




IF LN LT 1 


/*TEST OF DIMENSION N 


*/MFGR 290 




THEN GO TO RETURN,. 




MFGR 300 




eRROR='OS. 


/♦PRESET ERROR INDICATOR 


♦/MFGR 310 






/*INIT. COLUMN INDEX VECTOR 


*/MFGR 320 




PIV =0,. 


/♦SEARCH FIRST PIVOT ELEMENT 


♦/MFGR 330 




00 J =1 TO LN,. 


/♦EXECUTE LOOP OVER COLUMNS 


♦/MFGR 34C 




ICOL(J)=J,. 




MFGR 35C 




DO I =1 TO LM,. 


/♦EXECUTE LOOP OVER ALL ROWS 


♦/MFGR 360 




HOLD =A(I,J),. 




MFGR 370 




IF ABS(HOLO) GT ABS(PIV) 


MFGR 380 




THEN DO,. 




MFGR 390 




PIV =HOL0,. 


/♦SAVE VALUE AND INDEX OF THE 


«/1FGR 400 




IR =1,. 


/♦ABSOLUTELY GREATEST ELEMENT 


♦/MFGR 410 




IC =J,. 




MFGR 420 




END,. 




MFGR 430 




END, . 




MFGP 440 




END,. 




MFGR 450 




DO I =1 TO LM,. 


/■^INITIALIZE ROW INDEX VECTOR 


*/MFGR 460 




IRGW(I)=1,. 




MFGO 470 




END,. 




MFGR 480 




TOL =ABS(EPS*PI V) ,. 


/♦SET UP INTERNAL TOLERANCE 


*^«FGR 490 




IRANK=0, . 


/*««««*««*#** a *««#««« ««4««4,«*X' 


♦*/MFGR 500 




DO J =1 TO LN,. 


/♦GAUSS ELIMINATION 


♦/MFGR 510 




IF ABS<PIV) LE TOL 


/ i!'*.tt-«************t**t**«**9#* 


«*/MFGR 520 




THEN GO TO ROW,. 


/♦PIVOT IS NOT FEASIBLE 


*/MFGR 530 




IRANK=J,. 


/♦UPDATE RANK 


*/MFGR 540 




IF IP GT IRANK 


/♦SHOULD ROWS BE INTERCHANGED 


♦/MFGR 550 




THEN 00,. 




MFGR 560 




DO I =1 TO LN,. 


/♦INTERCHANGE ROWS 


•/MFGR 570 




SAVE =A(IRANK,I),. 




MFGR 580 




&< IRANK.n-AUR.I) 




MFGR 590 




AUR,I) = SAVE,. 




MFGR 600 




END,. 




MFGR 610 




IND =IROW(IR),. 


/♦UPDATE ROW INDEX VECTOR 


♦/MFGR 620 




IRQW(IRt=IROH(IRANKI,. 




MFGR 630 




IRCW11RANK)=IND, . 




MFGR 640 




END,. 




MFGR 650 




IF IC GT IRANK 


/♦SHOULD COLUMNS BE INTER- 


♦/MFGR 660 




THEN DO,. 


/♦CHANGEO 


♦/MFGR 670 




DO I =1 TO LM,. 


/♦INTERCHANGE COLUMNS 


♦/MFGR 680 




SAVE =A(I. IRANK) ,, 




MFGR 690 




A( 1,IRANK)=A(I,IC) 




MFGR 700 




A(I,IC)=SAVE,. 




MFGR 710 




END,. 




MFGR 720 




IND =ICOL(IC),. 


/♦UPDATE COLUMN INDEX VECTOR 


*/MFGR 730 




!CQLUC)=ICOLnPANKl,. 




MFGR 740 




ICOL(IRANK)=IN0,. 




MFGR 750 




END, . 




MFGR 760 




IND =IRANKtl,. 


/•INITIALIZE LOOP FOR TRANS- 


«/HFGR 770 




SAVE =PIV,, 


/♦FORHING CURRENT SUBMATRIX 


♦/MFGR 760 




PIV =0,. 


/♦AND SEARCHING NEXT PIVOT 


*/MFGft 790 




DO I =IND TO LM,. 




MFGR 800 




HOLD, A ( I, I RANK )=A( I, I RANK) /SAVE,. 


MFGR 810 




DO K =IND TO LN, . 




MFGR 820 




WnRK,A(I ,K)=A(I,K) 


-HOLO*A(IRANK,K),. 


MFGR 830 






/♦SEARCH NEXT PIVOT ELEMENT 


♦/MFGR 840 




IF ABS(WORK) GT ABS(PIV) 


MFGR 850 




THEN DO,. 




MFGR 860 




PIV =HORK,. 


/♦SAVE VALUE AND INDEX OF THE 


*/MFGR 870 




IR -I,. 


/♦ABSOLUTELY GREATEST ELEMENT 


♦/MFGR 880 




IC =K,. 




MFGR 890 




END,. 




MFGR 90C 




END,. 




MFGR 910 




END, . 




MFGR 920 




END,. 


/*«««»**««****«**«**««««««*««,* 


•*/MFGR 930 


ROW.. 


/♦COMPUTE ROW DEPENDENCIES 


•/MFGR 940 




IF IRANK= LM 


/***«*»******«*«*«««4'^*«*^**** 


♦♦/MFGR 950 




THEN GO TO HOM,. 


/♦ALL ROWS ARE BASIC ONES 


♦/MFGR 960 




DO J =IRANK-1 TO 1 9Y -1,. 


/♦SET UP MATRIX EXPRESSING 


♦/MFGR 970 




IR =J+1,. 


/♦ROW DEPENDENCIES 


♦/MFGR 980 




DO I =IND TO LM,. 


/♦LOOP FOR NON-BASIC ROWS 


♦/MFGR 990 




SUM =C,, 




MFGR 1 COO 




DC K =1R TO IRANK, 


. /*CALCULATE SCALAR PRODUCTS 


♦/MFGRIOIO 




SUM =SUM*MULT1PLY(A(I,K),A(K,J),53),. 


MFGR 1020 




END,. 




MFGR1030 




A(I,J)=A(I,J)-SUM,. 


/♦MODIFY ELEMENT 


♦/MFGR1C40 




END, . 




MFGH1050 




END,. 


/*«***«*,«***»*****»##****«»t**,/MFGRI060 1 


HOM. . 


/♦COMPUTE HOMOGENEOUS SOLUTION 


♦/MFGR1070 




IF IRANK= LN 




•♦/MFGR1080 




THEN GO 10 RETURN, . 


/♦ALL COLUMNS ARE BASIC ONES 


♦ /''FGR1090 






/♦SET UP MATRIX EXPRESSING 


♦/MFGRllOO 




DO J =IPANK rO 1 BY -1,. 


/♦BASIC VARIABLES IN TERMS OF 


♦/MFGRlllO 




IR =J*1,. 


/♦FREE PARAMETERS 


♦/MFGR1120 




00 I =INO TO LN,. 


/♦LOOP FOR FREE COLUMNS 


♦/MFGR1130 




SUM =C,. 




MFGR 1140 




DC K =IR TO IRANK, 


. /♦CALCULATE SCALAR PRODUCTS 


♦/MFGR1150 




SUM =SUM*MULTIPLY(A(J,K),A(K,I),53),. 


MFGR 1160 




END,. 




MFGR1170 




A( J,I)=-1A( J,I)+ SUMl/A 


IJ.J),. 


MFGRUBO 




END,. 




MFGR 1190 




END, . 




MFGR1200 


RETURN.. 




MFGR1210 




END, . 


/♦END OF PROCEDURE MFGR 


♦/MFGR1220 



For a given general rectangular matrix, MFGR 
performs the following: 

1. Determines rank and linearly independent rows 
and columns (basis) 

2. Factorizes a submatrix of maximal rank 

3. Expresses nonbasic rows in terms of basic 
rows 

4. Expresses basic variables in terms of free 
variables 

Usage: 

CALL MFGR (A, M, N, EPS, IRANK, IROW, ICOL); 

A(M,N) - BINARY FLOAT [(53)] 

Given general matrix with M rows and 
N columns. 

Resultant calculated triangular 
factors L, U and submatrices C, H, D. 

M - BINARY FIXED 

Given number of rows of matrix A. 

N - BINARY FIXED 

Given number of columns of matrix A. 

EPS - BINARY FLOAT 

Given relative tolerance for test on 
zero. 

IRANK - BINARY FIXED 

Resultant rank of given matrix. 

IROW(M) - BMARY FIXED 

Resultant vector containing the sub- 
scripts of basic rows in IROW(l) up to 
IROW(IRANK). 

ICOL(N) - BINARY FIXED 

Resultant vector containing the sub- 
scripts of basic columns in ICOL(l) 
up to ICOL(IRANK). 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error condition 
that may be detected: 

ERROR='P' means error in specified dimensions: 
M ^ and/or N^ 

Calculation of the rank of given matrix A is most 
critical. It is not claimed that MFGR will give the 
correct rank in all cases, because of the intrinsic 
difficulty caused by performing calculations with 
a finite number of digits 

Suggested range for values of EPS is 



10~^) in single precision and (10~^, lO"-'-^ 
precision. 



-4^ 

in double 
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Method: 

Calculation of the rank IRANK and of the triangular 
factors L and U is done using the standard Gaussian 
elimination technique with complete pivoting. The 
lower triangular matrix L is normalized so that the 
diagonal contains all ones , which are not stored. 
The subdlagonal part of L and the upper triai^lar 
factor U are stored in the locations of the given 
matrix A. 

In case A is sin^lar, the triangular factors L 
and U only of a submatrix of maximal rank are re- 
tained. The remaining parts of the resultant matrix 
give the dependencies of rows and columns and the 
solution of the homogeneous matrix equation 
A' X = 0. 

For reference see: 

A. S. Householder, The Theory of IVIatrlces in 
Numerical Analysis , 1965, pp. 125-130. 

Mathematical Background: 

Interchange information 



by imposing the following conditions: 

1. Ijl is the N by N identity matrix except for 
the first row. 

2. L^ is the M by M Identity matrix except for 
the first column. The first diagonal element 
has a value of one. 

3. D^ is an M by N matrix with first diagonal 
element equal to one, while all remaining 
elements of the first row and column are equal 
to zero. 

Partitioning of matrices A'^, L''', D^, tJ-^ leads to: 



1 .1 
*11 ^12 



A^ A^ 
^21 ^22' 



1 



d: 



22 



1 



^21 ' 



1 ttI 

"ll ^12 ' 



I 



Gauss elimination with complete pivoting implies 
that the rows and columns of the given M by N 
matrix A are interchanged at each elimination step 
if necessary. The interchaJige information is re- 
corded in two integer vectors IROW and ICOL: 

{ row ) 
The i-th < > of the interchanged matrix 

corresponds 

^ ^, ( mOV/(i)-th row ) , ^, .^ , 
to the < „^^ ;./ ., , > in the original 

I ICOL(i)-th column j 

matrix, where initially 

IROW(i)=i and ICOL(i)=i for i = P'^ ^l 

U,2, ..., N ) 

At the i-th elimination step the interchanged 
matrix is denoted by A^. 



where: 










= 


1 
^1 




4. 


= 


<. 




4. 


= 




1 
^1 


4. 


= 




12 22 



This implies the following: 

1. The elements of the first column of U are 



Ik 



a^ (k = l, 2, 3, ..., N) 



First elimination step 



a ,-, 



After pivoting, the interchanged matrix A is uniquely 
expressed as: 



a1 = l^ 



D^ 



IT 



2. The elements of the first column of L are 
1 



i->'^ 



il 



11 



(i = 2, 3, ,.., M) 
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3. The elements of submatrix D99 of D^ are 



22 



< =4 - I'l • 

ik ik il 


1 

"ik = 


1 
= a., - 
ik 


1 1 

^il • ^k 

1 

^11 


i =2, 3, ..., M 
k=2, 3, .... N 









Note tiiat it is possible to record all nontrivial 
information about L^, D^, U-*- in the storage loca- 
tions originally occupied by A, storing only: 





'21 °22 

Second elimination step 



Assume D22 is not zero in the sense that all its 
elements are absolutely greater than an internal 
tolerance TOL. The complete pivoting in d|2 
implies that matrix A-"- possibly is interchanged, 
giving A^: 



1 

d: 



Now DI2 may be expressed uniquely in the form: 





D' 



22 



32 




1 



d; 




2 2 \ 

S2 ^23^ 



It is easily seen that 
.2 



A^ = l2 



D 



U 



where 



-"32 



d2 = 




1 




33 



■'Il 



u2 = 







12 



22 



u: 



13 



u; 



23 



1 

Final elimination step 

2 
At the next step Dgg is factorized, and so on. Now 

assume that Dj^^j^^ ^^. equals zero — that is, that 

all its elements are absolutely less than or equal 

to TOL. This is interpreted as matrix A has the 

rank r and the result is the factorization: 



A^ = l'^ . D^ 



U 



Neglecting the small elements in D; 
be written as: 



^'^ =(lr) * <U, UR) 



with 



L = 



11 



U = 



r2 



12 



22 



r+1, r+1 



this may 



^^ = <Vl, r ^+1, 2 ^r+i, r> 



Ir 



2r 



r * 
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UR = 



1, r+1 



2, r+1 



\ r+1 

L is a lower triangular matrix of order r with unit 
diagonal. 

U is an r by r upper triangular matrix. 
LR is an (M-r) by r matrix; if the given matrix A 
is row regular (that is, r=M), LR is absent in the 
final factorization. 

UR is an r by (N-r) matrix; if the given matrix 
A is column regular (that is, r = N), UR is absent 
in the final factorization. 

Further calculations 

The problem of matrix factorization arises in con- 
nection with the solution of systems of equations 
A • X = R. Three different cases must be dis- 
tinguished: 

1. r = M =N 

A is nonsingular, and A • X = R has a unique 
solution. 

2. r < M 

A is not row regular; solutions of A • X = R 
exist only if the linear combinations among the rows 
of A are also valid among the rows of R. 

3. r <N 

A is not column regular; A • X = has non- 
trivial solutions. 

The cases (2) and (3) may occur together. The 
solution, if it exists, is uniquely determined for 
r=N; otherwise, it contains N-r free parameters. 
It is quite natural to ask for the linear combinations 
among the rows and columns of given matrix A and 
for the linear forms expressing basic variables in 
terms of free variables. Therefore, instead of LR 
and UR, matrices C and H, containing linear 
combinations, are returned. 

Observe carefully that the calculated factorization 
belongs to the interchanged matrix A^. Therefore, 
we use A^ ' X^ = R^ instead of A • X = R. 

Let X^, R^ be partitioned into^x^ ) ^^(r2 ) ' 



Then, from A^ • X^ = R^ Is obtained; 
(.h) • <". ^ ■ ill) <^) 

More explicitly: 

L • U • X, + L • UR • X„ = R, 



LR • U • X + LR • UR • \ ^ \ 



Since L and U are nonsingular, this implies 
that: 



^1 =U 



R = LR 



L ""^ R -U"''' 



R. 



UR'X^ 



For the user's convenience: 



LR is replaced by C = LR • L 



-1 



UR is replaced by H = -U 



UR 



while L and U remain unchanged. 
For consistency it is necessary to set 

R2 = Cj • R]^ and to obtain homogeneous 

solutions from the equation: 



Xj^ = H 



X„ 



In case of a consistent system of equations 
A-*^ • X^ = R^, the general solution is: 



-0) 



^1 

2 
+ H 



withX = U 



X. 



R, 



while the values of the free variables contained in 
X2 may be chosen arbitrarily. 

Programming Considerations: 

Let ajjj be the absolutely greatest element of the 
original matrix A, which is found first in column- 
wise scan. The internal tolerance TOL is set equal 
to I EPS • aik I . 

If, at the m-th elimination step, the absolutely 
greatest element of r^~m is less than or equal to 
TOL, the submatrix I^'m is interpreted as being 
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the zero matrix. Then m-1 is returned as rank of 
the given matrix A and further factorization is 
bypassed. 

The calculated factorization belongs to the inter- 
changed matrix A''. Therefore, we deal with A^ • 
xr = R'^ instead of A • X = R, where: 



> is obtained from < -af using the 



R 



( ICOL(k) I 



I IROW(i) I ^^"°^"^* °M S ' ^^ ] t'th ^ ^l^^^^'^t of 

151 



withk = 1, 2 N and i = 1, 2, ..., M 

Within the storage area 
originally occupied by the 
input matrix A, procedure 
MFGR returns, in a com- 
pact scheme, the matrices 
L, U, C, H, and D (see 
diagram). 



N 



-*-IRANK- 



Z 
< 



M 



L ^^ 


H 


C 


D 



From information in C, IRANK, IROW we get the 
linear dependencies among rows: 

row(l) = 0. 5 • row(3) + • row(2) 
row (4) = 1.5* row(3) - 1 • row(2) 

From information in H, IRANK, ICOL we get the 
homogeneous solution of A • X = 0: X = H * X : 

X = -0.33333325 x 
X = -0.33333331 x 

and with 

column (1) • xj + colxunn (2) • X2 

+ column (3) • Xg = 0, the linear dependencies 

among columns: 

coliunn (1) = 0. 33333325 • column (2) 
+0. 33333331 • column (3), 

Multiplying the triangular factors L, U we get: 

/4 2 

\2 4 



U =1 



32 33 



22 



23- 



Numerical example 



Let A = 



2 
2 

4 
4 



EPS = lE-5 



Procedure MFGR returns L, U, C, H, and D: 
L = ( „ t : I. U 



1 

0.5 



0^ 
1/' 



C = 



0.5 
1.5 



„ _, -0.33333325\ /b> 

"\-0. 33333331/' \0y 



and combines them in the following compact scheme: 




-0.33333325\ 
-0.33333331 | 







I 



IRANK = 2 
and IROW = (3, 2, 1,4) 
ICOL = (2, 3, 1) 
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FUK A GIVEN GENtRSL RECTANGULAR MATRIX MFGR PERFORMS THE FOLLOWING 

JtTERMINES ,UNK AND LINEARLY INDEPENDENT ROWS AND COLUMNS (B4SISI, FACT3RI2ES A SUBHATRTX nF MAXIMAL RANK, 

EXPRESSES BASIC VARIABLES IN TERMS OF FRFF VARIABLES. 



EXPRESSES N3N1SASIC ROUS IN TERMS CF BASIC ROWS, 



« * 

•PROCEDURE MFGR • 
• * 



*****B !**♦•*•** «♦ 



««4c4i ««««*«««*«*«* 



IS H 

LESS THAN 

ONE 



IS N ». NO 

LESS THAN .»... 
ONE .* 



***«»A2*****«**»* 



PRESET 
ERROR='0' 



***************** 



*****Q2 ********** 

* INITIALIZE * 
« COLUMN INDEX « 
» VECTOR ♦ 

* ICOLIJMJ. * 

* J=l,...,N ♦ 
***************** 



♦**♦ #02 **♦•♦•**♦• 
» SEARCH * 

» ABSOLUTELY • 

• GREATEST TERM « 
♦PIV OF ORIGINAL* 
» MATRIX A » 

******** ********* 



*****02 ********** 
•STORE ROW I NDEX* 

• IR AND COLUMN • 

• INDEX IC CF • 

• PIVOT PIV • 

• • 
***************** 



•***«E 2 •••••**••• 

• INITIALIZE ROW • 
» INDEX VECTOR * 

• IROhlI)=I, • 

• 1=1,.. .,M * 

• • 
••••••••••••««*** 



*****f 2********** 

• * 

• SET UP INTERNAL* 
•TOLERANCE TDL= * 

• =ABS!EPS*PIV) • 

• • 
«••**• 4 **•**«**** 



*****02 ********** 



* PRESET RANK 

• INDEX IRANK=0 



***************** 



••*** A3****^***** 
♦INITIALIZE J=l • 

•AS LOOP COUNTER* 
.X* FOR GAUSS • 

• ELIMINATION » 

• » 
**♦**♦***••****»* 



IS J 

GREATER 
THAN N 



B3 *. 
.* PIVOT *. 
.• FEASIBLE, •. NO 
. IS ABSIPIVl ••... 
•. GREATER .• 
• . TOL .» 
*. .• 
• YES 



«****C3********** 



UPDATE RANK, 
IRANK=J 



*•*••*•••**•**** 



03 *. 
.*SHOULD *. 
NO .* ROWS BE t. 
...•.INTERCHANGED,.* 
*.IS IR GT .* 
*.IRANK.* 
*. .* 
* YES 



*****F3****^«**** 



INTERCHANGE 
ROWS 



***************** 



****«F3»^******** 



UPOATE ROW 
INDEX VECTOR 



•*•*******•***•** 



G3 *. 

.•SHOULD *. 

.*CCLUHNS BE * 

.INTFRCHANGEO 

*.-IS IC GT.* 

•.IRANK.^ 

• . .* 

* YES 



♦♦♦••H3*^******** 



INTERCHANGE 
COtJMNS 



*•**••••**«*«**** 



*****jj********** 



• UPDATE COLUMN * 

* INDEX VECTOR *. 



***************** 



B5 *. 

.* ROWS *. 

. *INDE PENDENT*. 

. - IS IRANK . 

*. FOUAL TO .* 

*. M . • 

*. . * 



•••••C 5 *•*•**•••* 

* ♦ 

• SET UP MATRIX • 
♦EXPRESSING ROW • 

• DEPENDENCIES • 

* • 
***************** 



*****D4*****«**** 

• • 

• TRANSFORM • 
X^ CURRENT » 

• SUBMATRIX • 

• » 
***************** 



*****E4***^****** 



SEARCH NEXT 
PIVOT PIV 



***»••*****»♦**** 



**^^^F ^••••••**** 

•STORE ROW INDEX* 

* IR AND COLUMN * 

* INDEX IC OF » 

* PIVOT PIV • 

* » 
*****•**•*****••* 



•••••G4** ••••**** 



*••••**•*•••***** 



X 
HOH . *. 

05 *. 

. •COLUMNS*. 
YES . •INDEPENDENT*. 
.... *. -IS IRANK .« 
•.EQUAL TO .• 
•. N . • 
. •. . • 

• NO 



*****F5 **••••***• 

* SET UP MATRIX • 

* EXPRESSING * 
*BASIC VARIABLES* 

* IN TERMS OF * 
*FREE VARIABLES * 
••••«***•***•**** 



****K5********* 

* ENn OF » 
. X*PROCEDURE MFGR * 

• * 
*************** 
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• Subroutine MDLS/MDRS 











WOLS.. 




MOLS 


10 




ii:*:tf**:f********m***^ttt:^*:«.«.***t:^l^ 


«»/KDLS 


20 


/* 




*/MDLS 


3C 


/* FOP AN EQUATION SYSTEM fl*X 


R WITH SYMMETRIC POSITIVE 


♦/MOLS 


4C 


/« DEFINITE MATRIX A=T*TRANSPOSE ( T) CALCULATE OPTIONALLY 


♦/MOLS 


50 


/* SOLUTION X 




*/f^DLS 


60 


/* INVERSE(T) * R 




♦/MDLS 


70 


/* TRANSPOSE < INVERSE (T)l 


R 


♦/MDLS 


8C 


/* FOP GIVEN TPIANGULAR FACTOR 


T ANO RIGHT HAND SIDE MATRIX R 


♦/MDLS 


90 


/* 




*/MOLS 


ICC 


/»V*9*********^*1'**»***«****.***:V««**:i 


**a***!tt»**f*****li*#*ii***^^ir ****** 


♦♦/MDLS 


110 


PROCEDURE(R,M,N,A,CPT),. 




MOLS 


12C 


DECLARE 




MOLS 


13C 


ERROR EXTERNAL CHARACTER(l) 


/♦EXTERNAL ERROR INDICATOR 


*/MDLS 


!4C 


lOPT.CQPT) CHARACTERd), 


/*OPTION PARAMETER 


♦/MDLS 


15C 


SUM BINARY FLOAT{53). 




MOLS 


160 


(R(*,*I,A(*) 1 




MDLS 


170 


BINARY FLOAT, 


/♦SINGLE PRECISION VERSION /»S*/MDLS 


180 


/* BINARY FLOAT{53), 


/♦DOUBLE PRECISION VERSION /* 


D^/MOLS 


19C 


n,IENDtIl,IIA,IID,IIST,IK, 




MDLS 


2CC 


IKA,1K0,IKST,J,JEN0.K,L,LD, 




MDLS 


210 






MDLS 


220 






MDLS 


23C 




/««»•«»*«**«* 4:**4r««:4,«#*«#4:4:««» 


♦*/"DLS 


240 


nO,IKA=l,. 


/♦INITIALIZE PARAMETERS FOR 


*/MDLS 


2 50 


JKO,IIA=0,. 


/♦DIVISION FROM LEFT 


*/y')LS 


260 


lEND =N,. 


/**#«.*******»**«»t**«^* *<.«*,«* 


♦ */r*OLS 


27C 


JENO =M-1,. 




MDLS 


280 


GO TO BOTH,. 




MDLS 


290 


MORS . . 




MDLS 


3CC 


/«««***«*«t:«««4«>|>««««««*«**««««4r«»«< 


*<c4**A*««***«t:«««***««a«««.ft ««.««« 


♦♦/MDLS 


310 






•/MOLS 


320 


/* FOR AN EQUATION SYSTEM X*A= 


R WITH SYMMETRIC POSITIVE 


♦/MDLS 


33C 


/* DEFINITE MAT<5IX A=T*TRflNSP05E I T 1 CALCULATE OPTIONALLY 


*/MDUS 


340 


/* SOLUTION X 




*/MDLS 


350 


/* R « TRANSPOSE! INVERSEfTll 


♦/MOLS 


360 


/* R * INVECSE(T) 




♦/MOLS 


?7C 


/« FOR GIVEN TRIANGULAR FACTOR 


T AND RIGHT HAND SIDE MATRIX R 


♦/MDLS 


380 






♦/MOLS 


390 


/*»«*»*#»*****«*#**,**«*«♦»«**»♦»#,<,**««»»«**«, ft, *,*(,»,»#,,4,„^#.^^^^j 


♦*/MOLS 


4CC 


ENTRYlR,M,N,fl,OPTI,. 




MDLS 


41C 




/*««»««A*«******4:*««*c*S«««««*# 


**/MDLS 


420 


nD,IKA=0,. 


/♦INITIALIZE PAPAMETEPS FOP 


♦/MDLS 


430 


IKD,IIA=1,, 


/♦DIVISION FROM RIGHT 


♦/MOLS 


440 


lENO =M,. 




♦♦/MOLS 


45C 


JEND =N-l,. 




MOLS 


460 


BOTH.. 




MOLS 


47C 


ERROR=*P',. 


/♦P MEANS WRONG PARAMETER 


♦/MOLS 


480 


IF lEND LE 


/♦TEST INPUT DIMENSIONS M AND 


N*/MDLS 


49C 


THEN GO TO RETURN,. 




MDLS 


5CC 


IF JENO LT 




MOLS 


510. 


THEN GO TO PETUBN,. 




MDLS 


520 


IIST, IKST=!,. 




MOLS 


53C 


COPT =OPT,. 




MOLS 


540 


IF COPT= '2' 


/♦TEST SPECIFIED OPERATION 


♦/MDLS 


550 


THEN GO TO NEW,. 




MDLS 


560 




/ **«««««« ««**««***««*«««*«««*« 


♦*/MOLS 


570 


LX =C,, 


/♦INITIALIZATION FOR A*X = R 


♦/MOLS 


58C 


HSTA,MDEL,MX,LD=1,. 


/♦AND FOP X^TRANSPOSEIA) = P 


*/MOLS 


590 




/*«««*«*t*****t**««««*4:4.**4i*4r**«/MQ|_5 


600 


MAIN.. 


/♦EXECUTE DIVISION PROCESS 


♦/MDLS 


610 


DO J =C TO JEND.. 




MDLS 


620 


11 =IIST,, 


/♦INITIALIZE ADDRESSING VALUES 


♦/MDLS 


630 


IK =iKsr». 




MOLS 


64 C 


DO I =1 TO lEND,. 


/♦EXECUTE LOOP OVER COLUMNS 


♦/MDLS 


65C 


SUM =C,. 


/♦OR ROWS OF MATRIX R 


*/MCLS 


660 


L =MSTA,. 




MDLS 


670 


LDX =LD,. 




MDLS 


68C 


DO K =1 TO J,, 


/♦COMPUTE SCALAR PRODUCT SUM 


*/MDLS 


690 


SUM =SUH*MULTIPLY(A(L) ,R( I I , IK) , 53) , . 


MDLS 


700 


L =L«-LDX,. 




MOLS 


71C 


LDX =LOX*LX,, 


/*UPOATE ADDRESSING PARAMETERS 


*/MDLS 


720 


II =II+IID,. 




MOLS 


730 


IK =IK+IKD., 




MDLS 


740 


END,. 




MOLS 


750 


IF AIL)= C 


/♦IS DIAGONAL TERM IN A ZERO 


♦/MDLS 


76C 


THEN DO,. 




MDLS 


770 


EBRDfi=>S«.. 


/♦S MEANS ZERO DIAGONAL TERM 


•/MDLS 


780 


GO TO RETURN,. 


/♦IN TRIANGULAR FACTOR A 


♦/MDLS 


790 


ENO,. 




MOLS 


ecc 




/♦CALCULATE NEW ELEMENT 


♦/MOLS 


810 


ELSE Rni,IK) = IR(I I.IK) 


-SUM)/A(L),. 


MDLS 


820 


11 =HST+IIA*I,. 




MDLS 


B30 


IK =IKST+IKA»I ,. 


/♦UPDATE ADDRESSING PARAMETERS 


♦/MDLS 


840 


END,. 




MOLS 


850 


MSTA =MSTfltMDEL,. 


/♦MODIFY START PARAMETERS 


♦/MDLS 


860 


MOEL =HDEL»MX,. 




MDLS 


87C 


END,. 




MOLS 


880 


IF COPT NE •!• 


/♦TEST END OF OPERATION 


♦/MDLS 


890 


THEN 




MOLS 


900 


NEW.. 




♦♦/MDLS 


91C 


00.. 


/♦INITIALIZATION FOR X^A = R 


♦/MOLS 


92C 


COPT =•!',. 


/♦AND FOR TRANSPOSE(A)^X = P 


♦/MDLS 


930 


MX =0,, 


/**»^t*************f*:*>i>**Ati******/ttOtS 


940 


LX =1,. 




MOLS 


950 


MOEL =-t, . 




MDLS 


960 


LO =-JEND,. 




MOLS 


970 


MSTA =(JEN0+l)*lJEN0+2)/2,. 




MOLS 


980 


no =-IlD,. 




«OLS 


990 


IKO =-IKD,. 




MDLSIOCO 


IF nA= C 


/♦SHOULD DIVISION FROM LEFT 


*/MDLSlClC 


THEN IIST =M,. 


/♦BE EXECUTED 


*/f*0LSlC2C 


ELSE IKST =N,. 




''DLS103C 


GO TO MAIN,. 

ENDt . 
ERROR='0',. 
RETURN.. 
ENDt. 


/•GO TO MAIN PART OF MOLS 


•/MDLS1040 


/♦SUCCESSFUL OPERATION 
/♦END OF PROCEDURE MOLS 


MDLS1050 
♦/MDLS1060 

MOLS1070 
♦/MDLS1080 



Purpose: 



For a system of equations AX = R with symmetric 
positive definite matrix A = T • t"^, MDLS 



performs the following calculations depending on 
the character of the input parameter OPT: 



OPT = '1' 
OPT = '2' 
otherwise 



R is replaced by T"-'- • R 
R is replaced by (T"-'-)'^ • R 
R is replaced by (T • t"^)"^ 



R 



Usage: 



CALL MDLS (R, M, N, A, OPT); 



R(M,N) - 



M 



N- 



A(M*(M+l)/2) 



OPT 



BINARY FLOAT [(53)] 
Given general right-hand- side 
matrix with M rows and N 
columns. 

Resultant solution depending 
on the option parameter OPT. 
BINARY FIXED 

Given number of rows of matrix R 
and the order of matrix A. 
BINARY FIXED 
Given number of columns of 
matrix R. 

BINARY FLOAT [(53)] 
Given one-dimensional array 
containing lower triangular matrix 
T stored rowwise in compressed 
form (possibly resultant array A 
of SSP procedure MFS). 
CHARACTER (1) 

Given option parameter for selec- 
tion of operation. (See "Purpose" 
above. ) 



Purpose: 



For a system of equations XA = R with symmetric 
positive defiuite matrix A = T • t'^, MDRS per- 
forms the following calculations , depending on the 
character of an input parameter OPT: 



OPT = '1' 
OPT = '2' 
otherwise 



R is replaced by R • (T' 
R is replaced by R • T~- 
R is replaced by R • (T 



.1)T 



T^)- 



Usage: 



CALL MDRS (R, M, N, A, OPT); 

R(M, N) - BINARY FLOAT [(53)] 

Given general right-hand-side 
matrix with M rows and N columns. 
Resultant solution depending on the 
option parameter OPT. 

M - BINARY FIXED 

Given number of rows of matrix R 
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N 



A(N*(N+l)/2) 



OPT 



Remarks: 



BINARY FIXED 

Given number of columns of matrix 
R and the order of matrix A. 
BINARY FLOAT [(53)] 
Given one-dimensional array 
containing lower triangular matrix 
T stored rowwise in compressed 
form (possibly resultant array A of 
SSP procedure MFS). 
CHARACTER (1) 

Given option parameter for selection 
of operation (see "Purpose", above). 



Mathematical Background: 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR='P' - means error in specified dimensions: 

M :£ and/or N ^ 
ERROR='S' - means given triangular factor T has 

at least one diagonal term (pivot) equal 

to zero — that is, matrix A is not 

positive definite. 

The given lower triangular factor T is assumed to be 
stored in compressed form, that is, rowwise in 
successive K*(K+l)/2 storage locations, where K is 
the mmiber of rows (or colvunns) implied by 
compatibility: 

K = M in procedure MDLS 
K = N in procedure MDRS 

During calculation the lower triangular matrix T is 
not changed. The right-hand-side matrix R is re- 
placed by the solution depending on the character of 
parameter OPT. 

Method: 

It is supposed that the symmetric positive definite 
matrix A is given in the factored form (Cholesky): 

T 
A = T • T 

where T is the lower triangular factor (possibly 
calculated by SSP procedure MFS) and t"^ the 
transpose of T. 

The required calculations are done using forward 
and/or backward substitutions. 



Calculation 

Calculation of Y = (T"-"-)^ • R is done using back 



of X = T ■•■ ♦ R is done using forward 

substitution to obtain X from T • X = R. 
-1\T 



ward substitution to obtain Y from 

tT . Y = R. 
Calculation of Z = (T • tT)-1 • R is done by first 

solving T • X = R and then solving 

t"^ • Z = X. 
of X = R(T~ ) is done using forward sub- 
stitution to obtain X from X • T^ = R. 
of Y = R • T~l is done vising backward 

substitution to obtain Y from Y • T = R. 
of Z = R • (T • tT)-1 is done by first 

solving X • tT = R and then solving 

Z • T = X. 



Calculation ' 

Calculation 

Calculation 



Programming Considerations: 

The given lower triangular matrix T is assumed to be 
stored rowwise in successive storage locations. 
During calculation, T is not changed, while the right- 
hand-side matrix R is replaced by the solution 
depending on parameter OPT. If any diagonal element 
(pivot) of T is zero, the error parameter ERROR 
is set to 'S' and further calculation is bypassed. Any 
zero pivot in T means that the matrix A = T • T^ 
is not positive definite, possibly because of severe 
loss of significance in the factorization routine. 
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• Subroutine MDSB 



Usage: 



MDS6.. 






MDSB IC 


/**««#«*#♦************************* 




••/MDSB 20 


/* 






•/MDSB ?C 


/* 


FOR AN EQUATION SYSTEM A*X 


=R hITH SYMMETRIC POSITIVE 


*/MDSB ^0 


/* 


DETINITE BAND MATRIX A= 


TRANSPOSE (T)«T CALCULATE 


*/MDSB 50 


/* 


OPTIONALLY 




•/MDSB 60 


/* 


SOLUTION X 




•/MDSB 70 


/* 


TFANSPOSEIINVERSEITJI 


* 


*/MDSB 80 


/* 


INVERSE(T) * R 




•ZMOSe 90 


/* 


FOR GIVEN UPPER 6AN0 FACTOF 


T AND GENERAL RIGHT HAND 


•/MDSB 100 


/* 


SIDE MATRIX R 




•/MOSS 110 


/* 






•/MDSB 120 


/t*#***:t**f***tf.'Cl/**f******1:t^****** 


#«##««4r4:»««««>««***«*««4i>:'*« «**«««« 


••/MDSB 130 


PROCEDURE 1 A, R,N,NUO,M, OPT J,, 




MDSB lAO 


DECLARE 




MOSS 150 




ERROR EXTERNAL CHARACTER(l) 


, /*EXTERNAL ERROR INDICATOR 


«/HOSB 160 




(OPT, COPT) CHARACTERdl, 


/♦OPTION PARAMETER 


♦/MDSB 170 




SUM BINARY FLOAH53) , 




MDSB 180 




< A(»,*) ,R(*,*»,H) 




MDSB 190 




BINARY FLOAT, 


/♦SINGLE PRECISION VERSION /* 


S*/M0S9 200 


/* 


BINARY Fl OAT{ 53), 


/•^DOUBLE PRECISION VERSION /* 


D*/MDSB 210 




( I , [STA,IENO, INCR, J, K, 




MDSB 220 




KEND,KI,KTNC,KK,L,LM, 




MOSB 230 




LN,LNUD,H,N,NC,NR,NUO) 




MOSR 2<iO 




BINARY FIXED.. 




MDS8 250 


LN 


=N, . 


/•STORE VARIABLES N, NUD, M, 


•ZHDSB 260 


LNUD 


=NUD, . 


/*OPT FROM CALLING SEQUENCE 


*/MDSB 270 


LM 


=M,. 


/*INTD LOCAL PARAMETERS 


*/MDS9 280 


COPT 


=OPT, . 




MDSB 290 


ERROR='P', . 


/»P MEANS WRONG INPUT 


•/MDSB 300 


IF LNUO LT 


/*TEST SPECIFIED INPUT PARA- 


•/MDSB 310 


THEN 


GO TO RETURN,. 


/*M£TERS NUD, N, M 


•/MDSB 320 


IF LN LE LNUO 




MDSB 330 


THEN 


GO TO RETURN, . 


/•PROCEDURE RETURNS IF AT 


•/MDSB 3^0 


IF LM LT 


/•LEAST ONE OF THE PARAMETERS 


•/MDSB 35C 


THEN 


GO TO RETURN,. 


/*NUD, N, M IS WRONG 


•/MDSB 36C 






/* 


•/MDSB 370 


NC 


= LNUO-Hr. 


/*NC AND NR ARE MARKS FOR BEGIN*/MOSB 380 


NR 


=LN-LNUD,. 


/•AND END OF THE BAND STRUCTURE^/MOSB 39C 


IF CaPT= '2' 


/•SHOULD R BE DIVIDED BY T ONLY«/MDSB <iOO 


THEN 


GO TO UPPER,. 


/ t**^***********'***!*:****:***'*** 


**/KOSB AlO 


ISTA 


1NCR=1,. 


/•INITIALIZATION FOR 


•/MDSB 420 


TEND 


= LN,. 


/•TRANSPOSEIT) « X = R 


♦/MOSB 430 


KING 


=-1,. 


/ t**V***«*****>lt*******«ii****** 


••/MDSB 440 


MAIN.. 






MDSB 450 




DO I =ISTA TO I END SY INCR, 


. /*£XECUTE LOOP OVER ALL ROWS 


•/MDSB 460 




H =A(I,1),. 


/•STORE I-TH DIAGONAL EL'EMENT 


•/MDSB 470 




IF H = C 


/•AND TEST IT FOR ZERO 


•/MDSB 48C 




THEN 00,. 




MOSB 49C 




ERROP='S',. 


/*S MEANS ANY PIVOT IS ZERO 


•/MDSB 50C 




GO TO RETURN,. 




MDSB 510 




END, . 




MDSB 520 




KEND =NC. . 


/•KEND IS ENO VALUE OF THE 


•/MOSB 530 




IF INCR= 1 


/•INNERMOST 00-COUNTER K 


•/MDSB 54C 




THEN L =NC-I,. 


/*L IF DIVISION BY TRftHSPfT) 


•/MDSB 55C 




ELSE L =1-NR,. 


/*L IF DIVISION BY -MATRIX T 


•/MDSB 560 




IF L GT C 




MDSB 570 




THEN KEND =KENO-L,. 


/•MODIFY KEND 


•/MDSB 580 




00 J =1 TO LM,. 


/•LOOP OVER THE M COLUMNS OF R 


*/MDSB 590 




SUM =R[I,J),. 


/^INITIALIZE SUM 


•/MDSB 600 




KI,KK=I,. 




MDSB 610 




DO K =2 TO KEND, 


/•COMPUTE SCALAR PRODUCT SUM 


•/MDSB 620 




KI =KI+KINC,. 




MOSB 630 




KK ^KK-INCR,. 




MDSB 640 




SUM =SUM-MULTIPi 


Y(A!KI,K),R(KK,J),53I,. 


MOSB 650 




END,. 




MDSB 660 




R( 1,J|--=SUM/H,. 


/•DIVIDE SUM BY DIAGONAL TERM 


•/MDSB 670 




END, . 


/•AND STORE IT BACK 


•/MOSt 68C 




END,. 




MDSB 690 


IF CQPr= •!' 


/•TEST END OF OPERATION 


•/MDSB 700 


THEN 


00,. 




MDSB 710 




ERROR='C',. 


/•SUCCESSFUL DIVISION 


•/MDSB 720 




GO TO RETURN, . 




MDSB 730 




END,. 




MDSB 740 


UPPER.. 




/**•*****♦*»****<.«*♦*****»**»* 


•*/«DSB 750 


COPT 


='l',. 


/•INITIALIZATION FOC T * X = 


F^/MDSB 760 


ISTA 


=LN,. 


/ft* ****«***» *«**#***<■ «*****aK,s 


••/MOSe 770 


INCR 


=-1, . 




MDSB 780 


I END 


= 1, . 




MDSB 790 


KINC 


=0,. 




MOSP 800 


GO TO MAIN,. 


/•BRANCH TO THE MAIN LOOPS 


•/MDSB 810 


RETURN. 






MDSB 820 


END. 




/•END OF PROCEDURE MDSB 


•/MDSB 830 



CALL MDSB (A, R, N, NUD, M, OPT); 



A(N,NUD+1) 



Purpose: 

Depending on the character of the input parameter 
OPT, MDSB performs the following operations on a 
system of equations A • X = R with symmetric positive 
definite band matrix: 



A = T 



-1. T 



OPT ='1' R is replaced by (T ) • R 

OPT = '2' R is replaced by t"'^ • R 

T -1 

otherwise R is replaced by (T • T) • R 



R(N, M) - 



N 



NUD 



M - 



OPT - 



Remarks: 



BINARY FLOAT [(53)] 
Given two-dimensional array contain- 
ing the upper band factor T stored 
rowwise such that A(i, 1) are the 
diagonal elements ( i = 1, 2, ... N). 
This could be the resultant array A 
from SSP procedure MFSB. 
BINARY FLOAT [(53)] 
Given general right-hand- side matrix 
with N rows and M columns. 
Resultant solution depending on 
option parameter OPT. 
BINARY FIXED 

Given number of rows of matrices R 
and A. 

BINARY FIXED 

Given number of upper codiagonals of 
symmetric matrix A. 
BINARY FIXED 

Given number of columns of matrix 
R. 

CHARACTER (1) 

Given option parameter for selection 
of operation (see "Purpose"). 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR='P' - Indicates an error in specified 
dimension: NUD <0 or N s NUD 

ERROR='S' - means the given band factor T has 
at least one diagonal term (pivot) 
equal to zero — that is, matrix A is 
not positive definite. 

Upper factor matrix T, consisting of main diagonal 
and NUD upper codiagonals, is assumed to be stored 
rowwise in array A(N, NUD+1) such that A(i, 1) are 

the diagonal elements of T (i=l, 2 N). SSP 

procedure MFSB provides upper band factor T in its 
resultant array A, which may be used directly for 
input in MDSB. 

During calculation in MDSB, the band matrix T 
is not changed. The right-hand-side matrix R is 
replaced by a solution depending on the input 
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character of parameter OPT. Input values N and 
NUD should satisfy the restriction 

s NUD < N 



m = min (NUD + 1, N + 1 



i =N, N-1 1 

k=l, 2 M 



Method: 

Depending on the actual character of OPT, division 
of R by tT and/or T is performed using forward 
and/or backward substitutions. The result is 
returned in the locations of R. 

For reference see: 

R. S. Martin and J. H. Wilkinson, "Solution of 
Symmetric and Unsymmetric Band Equations and 
the Calculation of Eigenvectors of Band Matrices", 
Nimierische Matfaematik . Vol. 9, iss. 4, 1967, 
pp. 279-301. 

H. Rutishauser, "Algorithmus 1-Lineares 
Gleichungssystem mit symmetrischer positiv- 
definiter Bandmatrix nach Cholesky", Computing 
(Archives for Electronic Computing), Vol. 1, iss. 
1, 1966, pp. 77-78. 

Mathematical Background: 

The given elements of the upper factor matrix T 
are to be stored rowwise in array A so that A(i, 1) 
are the diagonal elements of T (i = 1, 2, . . . , N). 

Calculation of X = (T"-'-) -^ • R is done using 
forward substitution to obtain X from t"^ • X = R 
and satisfying the following recursive scheme: 



ik 



a. 



ik 



i-1 

r - 2-( a .,, • X , 
ik m,i+l-m mk 

m=m 




Calculation of Z = A" • R = (T^ • T)~^ • R is done 
by first computing X from T^" • X = R and over- 
writing on R, then solving T • Z = X, again in the 
locations of R. If R is equal to the unit matrix, this 
process replaces R with the inverse A~^ of A. It 
should be noted that in general A"-'- is no longer a 
band matrix. 

Programming Considerations: 

The upper band factor matrix T is assumed to be 
stored rowwise in the two-dimensional array 
A(N, NUD+1) such that A(i, 1) are the diagonal 
elements of T (i = 1, 2, .. . , N). Therefore, the 
elements A(i , k) of array A with i + k > N are ir- 
relevant and not used within MDSB. 

During calculation, the upper band factor T is not 
changed, while the right-hand-side matrix R is re- 
placed by a solution depending on the character of 
parameter OPT. 

If any diagonal element A(i, 1) of factor T is zero, 
the error parameter ERROR is set to 'S' and further 
calculation is bypassed. Any zero pivot of T means 
that matrix A = t'^ • T is not positive definite. 
This is possibly due to severe loss of significance in 
the factorization routine. 

If the SSP procedure MFSB provides the factor 
matrix T directly as input for MDSB, the resultant 
error indicator ERROR from MFSB should be tested. 



m = max (1, i - NUD) ; i = 1, 2, . . . , N 

" k = l, 2,.,,, M 
r 

(Any symbol V^ c is to be interpreted as 

m=m 


zero if r < m . ) 

' 

After each Xjj^ is computed, it is stored in the 
location r^j^. Analogously, computing Y = T"-"- • R 
is the same as solving the equation T • Y = R for Y. 
This is done using backward substitution in a 
similar recursive scheme: 



^ik - a 



ik 



mo 

^ik" 2-» V* ^i-l+m,k 
m=2 
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• Subroutine MDLG 



FOR AN EQUATION SYSTEM A*X=R WITH 
MATRIX A=L«U CALCULATE CPTIOWALLY 

SOLUTION X 

INVERSEILI • R 

INVFRSE(U) * R 
FOO GIVE^ TfilANGULAP FACTOR 



GENERAL NON-SINGULAR 



MDLG 
*/MOLG 



L. U AND PIGHT HAND SIDE R 



PROCEDURE (A, (i, IPE°,N,M,OPT),. 

DECLARE 

ERROR EXTERNAL CHAR ACTER( 1 » , 
CPT CHARACTER (1) , 
SUM BINARY FLOiT(53) , 



fA(* 



*) ,R1* 



*). 



LM 

LN 



BINARY FLCAT, 
BINARY FLOAT(531, 
{ IPER( «). i ,1 S,J, 
K,LM,L N.M.N) 
BINARY FIXED, . 
= Mt . 
=N, . 



CfiROO='P' , . 

IF LN LE P 

THEN GO TO RETURN, . 

IF LM LE 

THEN GO TO OETUCN,. 

EHROR='0' , . 

IF OPT- 

■'■Q UPPER , . 



THEN GO 



DO I 



IF H . 



1 TO LN,. 
Ad ,1 I ,. 



THEN DO,. 

ERFOR='S't. 

GO 70 RETURN,. 

END, . 
IS =IPER( I ) ,. 

DO K =1 TC LM,. 

SUM =R(IS,K.),. 

R( !S,K) = R(I ,KI ,. 

TO I- 



SUM 

END 

R( I,K1=SUM/H, 

END,. 
END, . 
IF OPT= • I' 
THEN GO TO RETURN,. 



=LN-1 Tn I BY -I,, 
00 K =1 TO LM,. 
SUM =R( I ,K),. 

00 J =H-1 TO LN, 

SUM 

END 
R( I,KI=SUM,. 
END, . 



RETURN.. 
END, . 



'/MDLG 

«/MOLG 
*/MOLG 
*/MOLG 
*/MOLG 
*/MOLG 
*/MDLG ICO 
****/MDLG no 
MDLG 12C 
MDLG 130 
«/MOLG 1^0 
*/MOLG 150 
MDLG 16C 
MDLG 170 
/*S*/MDLG 180 
/*D*/MDLG 190 
MOLG 200 
MOLG 210 
MOLG 220 
MOLG 230 
MOLG 240 
*/MDLG 250 
*/MDLG 260 
MDLG 270 
*/MOLG 280 
MDLG 290 
/^PRESET ERROR INDICATOR */MDLG 300 
/*SHOULD R BE DIVIDED 8Y U ONLY*/MDLG 310 
/'st***«***«***«**«*s*«#****(,^#4,^^„Q^g 320 
/*LOOP FOR DIVISION 8Y LOHER */MOLG 330 
/(^TRIANGULAR MATRIX L */MDLG 3A0 

/s****»*****s6*«*****«******cftft*/M0LG 350 
/*!S ANY DIAGONAL ELEMENT ZERO »/MDLG 360 
MDLG 370 
"/MOLG 380 
MOLG 390 
*/MOLG '^OO 
*/MOLG 410 
*/MOLG 420 
*/MDLG 430 
*/MDLG 440 
*/MDLG 450 
MDLG 460 
MDLG 470 
*/MOLG 480 
*/MDLG 490 
MDLG 500 
*/MOLG 510 

/*LOQP FOR DIVISION 8Y UPPER */MDLG 530 
/'TRIANGULAR MATIX U "/MOLG 540 

/*LDOP OVER THE M COLUMNS OF R VMDLG 560 
/♦INITIALIZE SUM */MDLG 570 

/•COMPUTE SCALAR PRODUCT SUM '/MOLG 580 
MOLG 590 
MDLG 600 
*/MDLG 610 
MOLG 620 
MDLG 630 
MDLG 640 
*/MDLG 650 



*EXTERNAL ERROR INDICATOR 
*OPT|ON PAPAMETEP 



^SINGLE PRECISION VERSION 
^DOUBLE PRECISION VERSION 



*P MEANS WRONG INPUT 

*TEST SPECIFIED PARAMETER N 



/*TEST SPECIFIED PARAMETER M 



/*S MEANS ANY PIVOT IS ZERO 

/*FOR PERMUTATION OF ROWS OF 
/*RIGHT HAND SIDE ARRAY R 
/SLOOP OVER THE M COLUMNS OF I 
/'INITIALIZE SUM 
/^RESTORE ROWS OF ARRAY R 
/♦COMPUTE SCALAR PRODUCT SUM 



SUM-MULTlPLY(fiII,JJ,R(J,K),53), 



♦DIVIDE SUM BY DIAGONAL TERM 
*AND STORE RESULT 



/*TEST END OF OPERATION 



SUM- MULT I PL Y ( A ( I , J > , R U , K » , 53 1 , . 
/*STORE RESULT 



/*END OF PROCEDURE MDLG 



Purpose: 

For a system of equations A* X = R, where A = L • U 
is a general nonsingular matrix, MDLG performs 
the following calculations, depending on the character 
of an input parameter OPT: 



OPT = T 
OPT = »2' 
otherwise 



R is replaced by L • R 
R is replaced by U • R 
R is replaced by (L • U)" 



R 



Usage: 



CALL MDLG (A, R, IPER, N, M, OPT); 

A(N, N) - BINARY FLOAT [(53)] 

Given two-dimensional array containing 

lower and upper triangular matrices L 

and U where the imit diagonal of U is 

omitted, 
R(N, M) - BINARY FLOAT [(53)] 

Given general right-hand-side matrix 

with N rows and M colimms. 

Resultant solution depending on the option 

parameter OPT. 



IPER(N) - BINARY FIXED 

Given integer vector containing the 

permutations of rows of the matrix A in 

factorization steps. 
N - BINARY FIXED 

Given order of matrix A and number of 

rows of matrix R. 
M - BINARY FIXED 

Given number of columns of matrix R. 
OPT - CHARACTER (1) 

Given option parameter for selection of 

operation (see "Purpose"). 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR='P' - means error in specified dimensions: 

M < and/or N ^ 
ERROR='S' - means that a diagonal element (pivot) 

in the given lower triangular matrix 

L is zero; further calculation is 

bypassed. 

The given matrix A is assimied to be factorized into 
a product of a lower triangular matrix L and an upper 
triangular matrix U using partial pivoting with row 
interchanges, where L and U are overwritten on A, 
omitting the unit diagonal of U. Details of the row 
interchanges are to be stored in the vector I PER. 
This required factorization may be obtained using the 
SSP procedure MFG. The resulting arrays A and 
IPER are used as input for MDLG. 

During calculation in MDLG the arrays A and 
IPER are not changed. The right-hand-side matrix 
R is replaced by a solution depending on the char- 
acter of parameter OPT, 

Method: 

The required calculations are performed using 
forward and/or backward substitutions, where the 
Interchange information is combined with the lower 
triangular matrix L. 

Mathematical Background: 

Suppose a general nonsingular matrix A of order n 
is factored into the form: 



A = P 



U 



where L is the lower triangular matrix, U the upper 
triangular matrix with unit diagonal, and P the per- 
mutation matrix corresponding to the integer vector 
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IPER. Then X = L"l • P"-^ • R = L"^ • R is cal- 
culated using forward substitution to obtain X from 
L • X = P"l • R = R. R is obtained from R by 
interchanging rows in the same way as the rows of 
matrix A are interchanged during partial pivoting 
in any factorization routine (for example, MFG). 

To calculate Y = U"l • R backward substitution 
is used in obtaining Y from U • Y = R. Calculation 
of Z = U-1 • L-1 • p-1 •_R = U"l • L"l • R is done 
by first solving L • X = R and then solving U • Z =X. 

Programming Considerations: 

Matrix A is assumed to be given in the factored 
form: 

A=P- L • U 

where the lower triangular matrix L and the upper 
triangular matrix U are overwritten on A, omitting 
the unit diagonal of U. The permutation matrix P 
is obtained by interchanging the rows of an n by n 
unit matrix according to information stored in the 
vector IPER. 



• Subroutine MIG 



MIG.. 






MIG 


10 


/****** 


**^*»»***********»****'>i*t**H 


******************************** 


♦*/MIG 


20 


/* 








• /MIG 


30 


/* 




INVERT A FACTORIZeO GENERAL 


MATRIX A. 


*/MIG 


«0 


/* 




4 MUST BE FACTORIZED INTO THE FORM A = L*U. MHERE THE 


«/MIG 


50 


/* 




UPPER TRIANGULAR MATRIX U CONTAINS THE UNIT DIAGONAL 


• /MIG 


60 


/* 




WHICH IS NOT STORED. 




•/MIG 


70 


/* 








•/MIG 


80 


/*«**«* 


****'***«**«t*****#***********t****$:»:»i»t,'t^t*************«****t: 


**/MIG 


90 




PROCEOUREIA.IPER.N),. 




MIG 


100 




DECLARE 




MIG 


110 






ERROR EXTERNAL CHARACTER(l) 


/♦EXTERNAL ERROR INDICATOR 


• /MIG 


120 






SUM BINARY FLqAT(53), 




MIG 


130 






tA(*,*),PIV) 




MIG 


140 






BINARY FLOAT, 


/•SINGLE PRECISION VERSION /*S»/MIG 


150 


/* 


BINARY FL0AT153) , 


/•DOUBLE PRECISION VERSION /*D^/MIG 


160 






(lPEC(«},i,j,K,LNtM,MN,N) 




MIG 


170 






BINARY FIXED,. 




MIG 


180 




LN 


=Nt. 




MIG 


190 




MM 


= LN-U. 




MIG 


200 




IF LN LE 


/•TEST SPECIFIED PARAMETER N 


•/MIG 


210 




THRN 


DO,. 




MIG 


220 






ERROR^'P',. 


/*P MEANS MRONG INPUT 


• /MIG 


230 






GO TO RETURN,. 




MIG 


240 






END,. 


/ *i**m*******************9:***** 


•*/MIG 


250 








/•INVERT LOWER TRIANG. MATRIX 


L^/MIG 


260 






DO I =0 TO MN,. 


/****««*«*«***«****««*****»«** 


••/MIG 


270 






M =1+1,. 




MIG 


280 






PIV =A(M,M),. 




MIG 


290 






IF PIV= 


/•IS ANY DIAGONAL ELEMENT ZERO 


♦/MIG 


300 






THEN 00.. 




MIG 


310 






ERRORS -S',. 


/•S MEANS NEXT PIVOT ELEMENT 


*/MIG 


320 






GO TO RETURN,. 


/•IS ZERO 


«/MIG 


330 






END,. 




MIG 


340 






PIV,A(M,MI=1/PIV,. 


/•CALCULATE NEM DIAGONAL TERM 


♦/MIG 


350 






DO J =1 TO I i . 


/♦EXECUTE LOOP IN M-TH ROW 


• /MIG 


360 






SUM =0,. 




MIG 


370 






DO K =J TO I,. 


/•COMPUTE SCALAR PRODUCT SUM 


• /MIG 


380 






SUM =SUM*MULTIPLV(A(H,K).A(K,J),531,. 


MIG 


390 






END,. 




MIG 


400 






AIM,J)=-SUM*PIV,. 


/•CALCULATE AND STORE NEW TERM 


•/MIG 


410 






END,. 




MIG 


420 






END,. 


/******«•«*»**♦♦,***♦**««»*♦*«♦♦/„ IG 


430 








/•INVERT UPPER TRIANG. MATRIX 


J^/MIG 


440 






00 I =MN TO 1 BY -I,. 




♦♦/MIG 


450 






M =1+1,. 




MIG 


460 






DO J =LN TO M BY -1,. 


/•EXECUTE LOOP IN I-TH ROW 


*/MIG 


470 






SUM =A{I,J),. 




MIG 


460 






DO K =M TO J-1,. 


/•COMPUTE SCALAR PRODUCT SUM 


♦ /MIG 


490 






SUM =SUM+MULTIPLY(A(I,K),AIK,J),53>,. 


MIG 


50C 






ENDt. 




MIG 


510 






AU,J1=-SUM,, 


/♦STORE NEW VALUE 


♦ /MIG 


520 






END,. 




MIG 


530 






END,. 


/«««««***:««***« *«*««4^«««««»»** 


•♦/MIG 


540 








/•MULTIPLY INVERSE(U1*INV(L) 


• /MIG 


550 






DC I =1 TO MN,. 


/ ^#*tt*tt*:*»*t*i*****A-*tf ******* 


• ♦/^'IG 


560 






M =1*1,. 




MIG 


57C 






DO J =1 TO LN,. 


/•EXECUTE LOOP IN I-TH ROW 


• /MIG 


SBC 






IF J LE I 




WIG 


590 






THEN SUM =A1I,J),, 


/*FQR LOWER TRIANGULAR PART 


• /MIG 


6CC 






ELSf no,. 




MIG 


610 






SUM =0,. 


/*IF ELEMENT All, J) BELONGS TO 


*/fIG 


620 






M =J,. 


/•THE UPPER TRIANGULAR PART OF 


♦ /MIG 


63C 






END,. 


/•MATRIX A 


•/MIG 


640 








/•COMPUTE SCALAR PRODUCT SUM 


♦/MIG 


650 






DO K =M TO LN,. 


/•OF I-TH ROW WITH J-TH COLUMN 


♦ /MIG 


660 






SUM =SUM*MULTIPLYIA( I ,K » , A( K, J ) ,53) , . 


MIG 


670 






END,. 




MIG 


68C 






A( I,J)=SUM,. 


/•STORE RESULT 


♦/MIG 


690 






END,. 




MIG 


7 CO 






END,. 


/******♦*«*«********»«*****♦*» 


**/WIG 


71C 








/•RE-INTEPCHANGE COLUMNS OF A 


*/M!G 


72C 






00 I =MN TO I BY -I,. 


/»it******1t:»****:^-t,lt9***tfif**>V^t'> 


**/MIG 


73C 






M =IPER(n,. 




■'IG 


74C 






IF M GT I 


/•SHOULD RE-INTERCHANGE BE DONE*/M!G 


750 






THEN DO,. 




MIG 


760 






DO J =1 TO LN,. 


/♦INTERCHANGE COLUMN I WITH 


♦ /MIG 


770 






DIV =A(J,I),. 


/•COLUMN IPER(I) 


•/MIG 


7 BO 






fli J,I)=A( J,M1 ,. 




MIG 


79C 






A(J,H)=PIV,. 




MIG 


SCO 






END,. 




MIG 


810 






END,. 




MIG 


820 






END,. 




WIG 


830 


RETURN. 


. 




MIG 


84C 




END. 




/•END OF PROCEDURE MIG 


♦ /MIG 


850 



Purpose: 

MIG inverts a general nonsingular matrix A, which 
is given In the factored form: 

A= L • U 

where the upper triangular matrix U contains the 
unit diagonal, which is not stored. 

Usage: 

CALL MIG (A, IPER, N); 

A(N,N) - BINARY FLOAT [(53)] 

Given two-dimensional array containing 
lower and upper triangular factors L and 
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U, where the trnit diagonal of U is not 

stored (possibly resultant array A of 

SSP procedure MFG). 

Resultant calculated inverse of matrix 

A. 
IPER(N) - BINARY FIXED 

Given vector contains the permutations 

of rows of the matrix in factorization 

steps. 
N - BINARY FIXED 

Given order of matrix A. 

Remarks: 



row-permutation matrix (imit matrix with inter- 
changed rows) resulting from partial pivoting in any 
factorization routine. Then A~^ is calculated in 
four steps: 

1. The elements Tjj^ of L"^ are computed from the 
elements Ij^ of L with the following recursive 
formulas: 



I '-^ 

ik 1.. , im mk 

II m=k 



i>k 



ERROR='P' - means error in specified dimension: 

N ^ 
ERRORf'S' - means that a diagonal element (pivot) 

in the given lower triangular matrix 

L is zero; further calculation is 

bypassed. 

Method: 



^k = T 



1., =0 
ik 



i=k 



i<i 



2. The elements Uik of U~^ are computed from the 
elements u^ of U with the following recurrsive 
formulas: 



It is required that the general nonsingular matrix 
A be given in the factored form: 

A = L • U 

where L means the lower triangular matrix and U the 
upper triangular matrix with unit diagonal. L and 
the superdiagonal part of U are stored in the storage 
locations of A, which may be factored by SSP pro- 
cedure MFG. 

In the first step MIG inverts L, giving L~ , which 
is overwritten on L. In the second step U-1 is 
calculated and stored in U. Then U~l is multiplied 
by L~l, giving, in an order determined by pivoting, 
the columns of A"-'-. These, finally, are reordered 
to produce A"-'-. 

For reference see: 

A. S. Householder, The Theory of Matrices in Nu- 
merical Analysis, 1965, pp. 125-130. 
A. Ralston and H. S. Wilf, Mathematical Methods 
for Digital Computers , Vol. 2, 1967, pp. 69-71. 
R. Zurm'uhl, Matrizen , 1964, pp. 75-77. 

Mathematical Background: 

Suppose A, a general nonsingular matrix of order 
N, is factored into the form: 



k-1 



A= P 



U 



where L is the lower triangular matrix, U the upper 
triangular matrix with unit diagonal, and P the 



u., = -u., - Y) u. • u , 
ik ik ~ , , im mk 



i<k 



k-1 
(any symbol ^ x is to be interpreted as zero) 
m^ 



^k = ^ 



^k = ° 



i=k 
i>k 



3. The elements ajj^ of the product U~^ • L"-'- are 
computed with the formulas: 



N 

a., =1, + Z) u. • T , iak 

ik ik . , im mk 

m=i+l 



N 
m=k 



i<k 



4. The resultant product U~ • L"-'- is multiplied 
on the right by the inverse permutation matrix P"-'- 
giving: 

A-1=U-1-L-1.P-1 

That is, the columns of the product IT^ • L"-*- are 
rearranged according to the interchanges performed 
during the factorization of the matrix. 
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Programming Considerations: 

Matrix A is required in the factored form: 

A= P • L • U 

where L is the lower triangular matrix, U the upper 
triangular matrix with unit diagonal, and P the 
permutation matrix corresponding to the integer 
vector IPER. L and the superdiagonal part of U are 
to be stored in the two-dimensional array A. 

If the required factorization is done using the SSP 
procedure MFG, the resulting arrays A and IPER 
may be directly used as input for MIG. The inverse 
matrix A'^ is calculated by MIG in the storage 
locations of array A. 



• Subroutine MIS 



MIS.. 



INVERT SYMMETRIC POSITIVE DEFINITE MATRIX 



****** 



V******. 



PROCEOUREfA.N) 
DECLARE 

ERROR EXTERNAL CHARACTERdJ. 

SUM BINARY FLOAT! 53 J , 

141*), PIV) 

BINARY FLOATi 
* BINARY FL0ATt53l , 

I !COL.|PIV,IROW,J,K,L.LN,M,N) 

BINARY FIXED,. 



/♦EXTERNAL ERROR INDICATOR 



/*SINGtE PRECISION VERSION /* 
/•DOUBLE PRECISION VERSION 



IN 



«N,. 
=0,, 



IF LN LE 
THEN 00,. 

ERROR*'?',. 

GO TO RETURN, . 

END,. 

00 K »0 TO LN-l,. 
IPIV «0,. 

J -J*l,. 

PIV =AIJ*K),. 
IF PIV= 
THEN DO,. 

ERRCR-*S',. 

GO TO RETURN,. 

END,. 
PIV,A(J*K)-1/PIV,. 

DO L -I TO K,. 

SUM «0,. 

IRON <=J,. 

IC0L,1PIV»IPIV*L,. 
DO M "L TO K,. 



/♦INVERT TRIANGULAR MATRIX 

/•TEST SPECIFIED PARAMETER N 
/*P MEANS WRONG INPUT 



MIS 

**/MlS 

*/MIS 

*/MIS 

*/MIS 

•*/MIS 

MIS 

MIS 

• /MIS 
MIS 
MIS 

S^/MIS 
0*/MIS 
MIS 
MIS 

• /MIS 

• /MIS 
**/MIS 

MIS 
•/MIS 

MIS 



/•PERFORM LOOP OVER ALL ROWS 



/•IS ANY DIAGONAL ELEMENT ZERO 



/*S MEANS MATRIX IS NOT 
/•POSITIVE DEFINITE 



/•CALCULATE SCALAR PRODUCTS 



SUM =SUM*MULTIPLY1AUROH},AIICOL),53),. 
ICOL =ICOL+M,. 



IROW =IR0W+1, 

END,. 
AIJ) =-SUM*PIV,. 
J =J-H,. 
END,. 



• /MIS 
MIS 
MIS 

*/MlS 

MIS 
MIS 
MIS 
MIS 
•/MIS 
MIS 

• /MIS 

• /MIS 

MIS 

MIS 

/•EXECUTE LOOP IN (K+1)-TH ROW ^/MIS 

MIS 



MIS 
•/MIS 

MIS 

MIS 
MIS 
MIS 

• /MIS 

MIS 

MIS 

'•/MIS 

• /MIS 
'•/MIS 

• /MIS 

MIS 
•/MIS 
MIS 
MIS 
MIS 
•/MIS 

Mis 

HIS 

MIS 
MIS 
MIS 
MIS 
MIS 
*/MIS 



/•CALCULATE NEW ELEMENT 



/•MULTIPLY WITH TRANSPOSE 
/•PERFORM LOOP OVER ALL ROWS 
/•EXECUTE LOOP WITHIN K-TH ROM 



; =1 TO LN,. 

I --K,. 
DO L =1 TO K,. 
SUM =C,. 
ICOL,J=J+I,. 
IBOW =IfiOM-l,. 

DO M =K TO LN,. /•CALCULATE SCALAR PRODUCTS 

SUM =SUH+MULTIPLY(A(IC0L),A1IC0L*IR0W»,53),. 

ICOL =ICOLtM,. 

END,. 
A(J) =SUM,. 
END,. 



/•END OF PROCEDURE MIS 



IOC 

110 

120 

130 

140 

150 

160 

170 

180 

19C 

200 

210 

220 

230 

240 

250 

260 

270 

280 

290 

?C0 

310 

320 

330 

340 

350 

360 

370 

380 

390 

400 

410 

420 

430 

440 

450 

460 

470 

480 

490 

500 

510 

520 

530 

540 

550 

560 

570 

580 

590 

600 

610 

620 

630 

640 

650 



Purpose: 

MIS inverts a symmetric positive definite matrix A, 
which is given in factored form (Cholesky): 

A = T • transpose (T) 

Usage: 

CALL MIS (A, N); 



A(N*(Nfl)/2) 



N 



BINARY FLOAT [(53)] 
Given one-dimensional array con- 
taining the lower triangular factor T 
of matrix A stored rowwise in com- 
pressed form (possibly resultant 
array A of SSP procedure MFS). 
Resultant lower triangular part of 
calculated inverse (A) stored row- 
wise in compressed form. 
BINARY FIXED 
Given order of matrices A and T. 
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Remarks: 

ERROR='P' 

ERROR='S' 



means error in specified dimension: 
N^ 

means given triangular factor T has 
at least one pivot equal to zero — 
that is, matrix A is not positive 
definite. 



The given lower triangular factor T is assumed to be 
stored in compressed form ~ that is, rowwise in 
N*(NH)/2 successive storage locations. On return 
the lower triangular part of the inverse of A is 
stored in tiie same way. 

Method: 

It is supposed that the symmetric positive definite 
matrix A is given in the factored form (Cholesky): 

A = T • transpose (T) 

where T is the lower triangular factor, possibly 
calculated by SSP procedure MIS. 

In the first step MIS inverts the given triangular 
matrix T in the storage locations of T. Using 

inverse (transpose (T)) = transpose (inverse (T)) 

in the second step MIS multiplies inverse (T) with 
its transpose on the same storage locations, giving 

inverse (A) = transpose (inverse (T)) 

• inverse (T) 

Thus, the given lower triangular factor T is re- 
placed by the lower part of the resultant inverse (A). 

For reference see: 

A. S. Householder, The Theory of Matrices in 
Numerical Analysis ," 1965. pp. 125-130. 
R. Zurmlihl, Matrizen, 1964, pp. 77-79. 

Mathematical Background: 

Suppose the symmetric positive definite matrix A is 
factored in the form: 

A = T • transpose (T) 

where T is a lower triangular factor matrix. Then: 

inverse (A) = transpose (inverse (T)) 

• inverse (T) 



1. The elements tik of inverse (T) are computed 
from the elements tjk of T using the following re- 
cursive formulas: 



i-1 



- m=k 


t. 
im 


* 




*ik"~ 
n 




*ik = « 





i>k 



i=k 



i<k 



2. From inverse (T) the elements aik of inverse 
(A) are calculated as follows: 



a. 



N 



Ik ^ mk mi 



iSk 



with a., = 
ik 



\i 



Programming Considerations: 

The given lower triangular matrix T is assumed to 
be stored in compressed form ~ that is, rowwise 
in N . (]SfH)/2 successive storage locations. The 
lower triangular part of the resultant inverse (A) is 
returned in these locations of T. 

If any pivot of the input matrix T is equal to zero, 
the error parameter ERROR is set to 'S' and further 
calculation is bypassed. Any zero pivot in T means 
that matrix A = T • transpose (T) is not positive 
definite, possibly because of severe loss of signif- 
icance in the factorization routine. 
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♦ Subroutine MINV 



HINV "'"^ 

«i****»**«*«***#****»******* •**»*• ♦********************************'"''*^ 

*/MlNV 
•/MINV 
*/MINV 

MINV 
HINV 



TO INVERT A MATRIX 



/* 



.CON) t 



PROCEDURE (A,N, 
DECLARE 

ERROR EXTERNAL CHARACTERI I ) . 

(l.J.K,N,L(N)fM(Nn 

FIXED BINARY, 

(AC*.*)i6IGA,H0LD,D,C0N,S) 

BINARY FLOAT,. 
* BINARY FLOAT (53) ,. 

ERROR='0* ,. 
IF N LE 
THEN DO,. 

ERROR='l' ». 

GO TO FIN,. 

END,. 
If CON= 

THEN S =l,0E-5,. 
'♦THEN S =1.0E-15,. 
ELSE S =CON,. 
IF N = 1 
THEN DO 



70 



HINV 90 

HINV 100 

HINV 110 

HINV L20 

*S*/HINV 130 

/*D*/HINV 140 

*/MINV 150 

HINV 160 

MINV 170 

HINV 180 

*/HINV 190 

HINV 200 

HINV 210 

HINV 220 

/* SINGLE PRECISION VERSION /♦S»/MINV 230 
/* DOUBLE PRECISION VERSION /♦D»/H1NV 240 



/♦SINGLE PRECISION VERSION 
/♦DOUBLE PRECISION VERSION 



ORDER OF HATRIX 



/* INVERT A SCALAR 



/♦ SEARCH FOR LARGEST ELEMENT 



INTERCHANGE ROWS 



=A(1,1)*. 
!F A6S(0) LE S 
THEN DO,. 

ERR0R='2',. 
END,. 
ELSE All.n = 1/D 
GO TO FIN,. 
END,. 
=1.0,. 

DO K = 1 TO N,. 
UK) =K,. 
H(K) =K,. 
BIGA =A(K,K) ,. 

DO I=K TO N,. 

00 J=K TO N,. 

IF ABStBIGA) LT ABSIAIl.J)) 

THEN 00,. 

BIGA =At I,J) ,. 
L(K) =!,. 
M(K) =J,. 
END,. 
END,. 
END,. 
J =L)K1 
IF UK) GT K 
THEN DO.. 

DO I - I TO N,. 
HOLD =-A(K,I),. 
A(K,1)=AIJ.I) ,. 
A( J,I)=HOLD,. 
END,. 
END.. 
I =M(K),. /* INTERCHANGE COLUMNS 

IF M(K) GT K 
THEN DC 

DO J = 1 TO N,. 
HOLD =-A( J,K),. 
A(J,K)=AI J,I) ,. 
A( J,I t=HOLD,. 
END.. 
END,. 
IF ABS(BIGA) LE S 
THEN DO,. 

=0.0,. 
GO TO COHP,. 
END,. 

DIVIDE COLUMNS BY MINUS PIVOT (VALUE OF PIVOT ELEMENT IS 
CONTAINED IN BIGA) 

DO I = 1 TO N,. 

IF I NE K 

THEN An.K)=A(l,K»/(-A(K,K)),. 

END,. 

00 I = 1 TO N.. /* REDUCE HATRIX 

IF I 



THEN DO,. 



DO J = 1 TO N, 



THEN A(I,J)-A(I,KI^A(K,J)* 
END,. 



END,. 
DO J 



DIVIDE BY ROW PIVOT 



THEN A(K,J)=A(K,J>/A(K,K),. 

END,. 

=D«A(K,K)*. 



IF ABS(D) LE S 
THEN 00,. 

ERR0R='2*,. 

GO TO FIN,. 

END,. 
A{K,K)=l.0/A(K,K), 
END,. 



* COHPUTE DETERMINANT 



DETfcRHINANT IS ZERO 



/* REPLACE PIVOT BY RECIPROCAL 



FINAL ROW AND COLUMN INTERCHANGE 



/* 

K 


=N,. 




LOOP.. 






K 


=K-1 




IF K 


GT 




THEN 


DO,. 


=L(K1,. 




IF I 


GT K 




THEN 


DC 

DO J = 1 TO N,. 

HOLD =A1J,K),. 

AIJ,K)=-A{J,1),. 

A(J,n=HOLD,. 

END,. 
END,. 




J 


=M(K),. 




IF J 


GT K 




THEN 


DO,. 

00 I = 1 TO N,. 
HOLD =A(K,n,. 



MINV 250 
♦/HINV 260 
HINV 270 
MINV 280 
HINV 290 
MINV 300 
HINV 310 
MINV 320 
MINV 330 
HINV 340 
HINV 350 
♦/HINV 360 
HINV 370 
HINV 380 
MINV 390 
MINV 400 
MINV 410 
HINV 420 
HINV 430 
MINV 440 
MINV 450 
MINV 460 
HINV 470 
MINV 480 
MINV 490 
HINV 500 
*/M!NV 510 
MINV 520 
MINV 530 
MINV 540 
MINV 550 
MINV 560 
MINV 570 
MINV 
MINV 590 
♦/MINV 600 
MINV 610 
HINV 620 
MINV 630 
MINV 640 
MINV 650 
HINV 660 
HINV 670 
MINV 680 
MINV 690 
MINV 700 
HINV 710 
HINV 720 
MINV 730 
♦/MINV 740 
♦/HINV 750 
♦/HINV 760 
HINV 770 
MINV 780 
HINV 790 
MINV 800 
♦/HINV 810 
MINV B20 
MINV 830 
HINV 840 
HINV 850 
MINV 860 
HINV 870: 
HINV 880 
HINV 890 
MINV 900 
♦/MINV 910 
MINV 920i 
HINV 930 
♦/HINV 940 
MINV 950 
MINV 960 
MINV 970 
♦/MINV 990. 
MINV 990 
MINVIOOO 
/HINVIOIO 
HINV 1020 
/HINV1030 
/MINV1040 
/HINV1050 
MINV1060 
MINV 1070 
HINVI080 
HINV1090 
HINVllOO 
HINVlllO 
M1NV1120 
MINV1130 
HINV1I40 
MINV1150 
HINV1160 
HINV1170 
HINV1180 
M1NV1190 
HINV1200 
HINV1210 
H1NV1220 
MINV1230 
MINV1240 



A(K,Il=-AlJ,n.. 
A( J,I)=HOLD,. 
END,. 



END,. 
GO TO LOOP, 
END,. 
FIN.. 

RETURN,. 
END,. 



/♦END OF PROCEDURE MINV 



MINV1230 
MINV1260 
M1NV1270 
HINV1280 
MINV1290 
H1NV1300 
MINV1310 
HINV1320 
♦/M1NV1330 



Purpose: 

MINV inverts a general square matrix. 

Usage: 

CALL MINV (A, N, D, CON); 

A(N,N) - BINARY FLOAT [(53)] 
Given matrix. 
Resultant inverse of given matrix. 

N - BINARY FIXED 

Given order of matrix A. 

D - BINARY FLOAT [(53)] 

Resultant determinant. 

CON - BINARY FLOAT [(53)] 

Given constant with which the determinant 
is compared, if the given value of CON 
is zero, the program assigns the value 10 
in single precision and lO"-*-^ is double 
precision. 

Remarks: 

A must be a general square matrix. 

If no errors are detected in the processing of 
data, the error indicator, ERROR, is set to zero. 
The following constitute the possible error condi- 
tions that may be detected: 



ERROI^l - 



ERROR=2 - 



means that the order of the matrix is 
less than or equal to zero, 
means that the absolute value of the 
determinant is less than or equal to the 
specified constant CON (see descrip- 
tion of parameters for explanation). 



Method: 



The standard Gauss-Jordan method is used and the 
determinant is calculated. 
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Subroutine MLSQ 



ML SO.. 






MLSQ 10 






«**»«**#*«*****»*««******»**»««***/MI.SQ 20 ;| 


/* 






♦/MLSQ 30 


/* 


LINEAR LEAST SQUARES PROBLEM 


SOLVED USING HOUSEHOLDER TRANSF 


♦/MLSC 40 


/* 






*/MLSQ 50 


/**«.*** 


t^ Vt:irif **»*#***«**************■ 


♦ **ft«**»«*##****«*****»***«*##**»*/MLSQ 60 1 


PROCeDURE( A,eiM,N,K) , . 




ML SQ 70 


DECLARE 




ML SO BO 




(fl(*,*),e(*,*),PIVR,MflXA) 




MLSQ 90 




BINARY FLOAT, 


/♦SINGLE PRECISION VERSION /* 


S^/MLSQ 100 


/* 


eiNARY FLOAT(531 , 


/*0OUBLE PRECISION VERSION /* 


OVMLSQ 110 




(AUX(N),H, SIG, BETA) 




MLSQ 120 




BINARY FLDAT(5,3) , 




MLSQ 130 




|TOL,PIV(N)» 




MLSQ 140 




eiNARY FLOAT, 




ML SO 150 




EPCOO EXTERNAL CHARACTER( 1 ) , 


/*EXTERNAL ERROR INDICATOR 


♦/MLSQ 160 




(1,J,K,L,M,N,P1VI,LM.LN,LK) 




MLSQ 170 




BINARY FI XED,. 




MLSQ 180 


LM 


=M, . 




MLSQ 190 


LN 


=N,. 




MLSQ 200 


LK 


= K, . 




MLSQ 210 


SIG 


=C, . 




MLSQ 220 


ERRDR='D',. 


/•PRESET ERROR INDICATOR 


♦ /MLSQ 230 


IF LM GE LN 


/*IF M LESS THAN N 


♦/MLSQ 240 


THEN 


IF LN GE C 


/•OR If N NOT POSITIVE 


♦/MLSQ 250 


THEN 


IF LK GT C 


/«0R IF K NOT POSITIVE 


♦/MLSQ 260 


THEN 


DO,. 


/*THEN BYPASS OPERATION 


♦/MLSQ 270 




DO L = 1 TO LN,. 


/•CALCULATE SCALARPROOUCTS OF 


*/MLSQ 280 




H =C.,. 


/•COLUMNS 


♦/MLSQ 290 




DO I = 1 TO LM,. 




ML SO 300 




H =HtHULTIPLV(A(I,Ll ,A( 1,L),53»,. 


MLSQ 310 




END,. 




MLSQ 320 




IF H GE SIG 




MLSQ 330 




THEN DO,. 




MLSQ 340 




SIG =H,. 


/♦SAVE MAXIMAL SCALARPRODUCT 


♦ /ML SO 350 




PI VI =L,. 


/•SAVE SUBSCRIPT OF PlvaTCOLUMN*/MLSQ 360 | 




END,. 




MLSQ 370 




AUX(L) ,PIV(L)=H,. 




MLSQ 380 




END, . 


/*******«*»*»*«»«*««****«***«*»*/MLSQ 390 1 






/•DECOMPOSITION LOOP 


*/MLSQ 400 




ERROR='0',. 


/***«*«««*««***********««««*«* 


♦♦/MLSQ 410 




DO L = 1 TO LN,. 




MLSQ 420 




TOL =PIV(PIvn,. 


/♦ORIGINAL LENGTH OF PIVOTCOL. 


♦/MLSQ 430 




IF PIVI GT L 


/•SHOULD COLUMN 6E INTERCHANGEO*/ML SO 440 | 




THEN DO.. 




MLSQ 450 




H =AUX(L),. 


/•INTERCHANGE SCALARPROOUCTS 


♦ /MLSQ 460 




AUX(L)=AUX(PIVI) , 




MLSQ 470 




PIV(P!Vn=PIV(L). 




MLSQ 480 




AUX(PIvn=H,. 




MLSQ 490 




DO J=L TO LM 


. /*INTERCHANGE LOWER PAPT OF 


♦ /ML SO 500 




PIVR =A1J.L1 


. /*COLUMNS OF A 


♦/MLSQ 510 




A(J,L)=A(J,PIVI),. 


MLSQ 520 




A(J,PIvn = PIVP,. 


MLSQ 530 




ENO,. 




MLSQ 54C 




ENO,. 




MLSQ 550 




IF L GT I 


/♦RECALCULATE COLUMN LENGTH 


*/MLSQ 560 




THEN 00,. 


/♦rO AVOID ROUND-OFF PROBLEMS 


♦/MLSQ 570 




SIG -C. 




MLSQ 590 




DO I = L TO 


LM.. 


MLSQ 590 




SIG =SIG+MULTIPLY(A1I,L),A(I,L).53I,. 


MLSQ 60C 




ENO,. 




ML SO 610 




END,. 




MLSQ 620 




IF TOL= C 




MLSQ 630 




THEN 00. . 




MLSQ 640 




IF EPROfi NE 'S' 




MLSQ 650 




THEN IF EPROR NE 


•W 


MLSQ 660 




THEN ERROR=*S', . 


/•GIVEN A HAS ZERO-COLUMNf S) 


*/MLSQ 670 




FUSE EPPQR='e*,. 




MLSQ 680 




TOL =1.. 




MLSQ 690 




ENO.. 




MLSQ 700 




BETA =T0L»1E-10.. 


/♦SINGLE PRECISION VERSION /*S^/MLSQ 7l0l 


/« 


■5ETfl =T0L*1E-2C,. 


/♦OOUBLE PRECISION VERSION /«D*/»LSQ 7201 




IF SIG LE BETA 




MLSO 730 




THEN DO,. 


/•INDICATE LOSS OF SIGN IF ICANCE*/ML SO 740| 




IF ERROR NE -B* 




MLSQ 750 




THEN IF EfifiOF NE 


' S * 


MLSQ 760 




THEN EOCOR="w<,. 




MLSQ 770 




ELSE EPROf!='B' ,. 




MLSQ 760 




IF SIG LE 




MLSQ 790 




THEN SIG =SETa,. 


/♦MODIFY ZERO VALUE 


♦/MLSQ 600 




END,. 




MLSQ 810 




SIG =SQRT(SIGt,. 




MLSQ 820 




H =AIL,LI,. 




MLSQ 830 




IF H LT 




MLSQ 840 




THEN SIG ^-SIG,. 


/♦FORCE SIGN(SIG) TO SIGN(H) 


♦ /ML SO 850 




PIV(LI=PIVI ,. 


/♦SAVE INTERCHANGE INFORMATION •/MLSQ 860| 




AtL.Ll ,eETA=H*SIG.. 


/♦TRANSFORM DIAGONAL ELEMENT 


♦/MLSQ 870 




AUX(L)=-SIG.. 


/•SAVE DIAGONAL ELEMENT 


♦/MLSQ 880 




BtTA =SIC*BETA,. 




MLSQ 890 






/•TRANSFORM SUBMATRIX OF A 


♦/MLSQ 900 




PIVR =0,. 




ML SO 910 




00 J = L*l TO LN. 


. /*TRANSfORM LOWER PART OF A 


♦/MLSO 920 




H =C , . 


/♦COLUMNS L*l \}P TO N ONLY 


♦/MLSQ 930 




or I = L Tf 


Lt'.. 


MLSQ 940 




H =H+MULT!PLY{A( I . L) , A( I , J ) , 53 ) , . 


MLSQ 950 




END,. 




MLSQ 960 




SIG =H/0ETA,. 


/♦MODIFY J-TH COLUMN 


•/MLSQ 970 




DO I = LM TO 


L BY -1,. 


MLSQ 980 




H =A(1,J) 


, . 


MLSQ 990 




A(I,J)=H-A( I 


,L)«SIG,. 


ML SO 1000 




END,. 


/♦NEXT UPDATE COLUMN LENGTH 


•/MLSQIOIO 




H =a(L,j),. 




MLSQ1020 




AUXt J) ,H=AUX( J)-H 


*H, . 


MLSQ1030 




IF H GE PIVR 


/•SEARCH NEXT PIVOTCOLUMN 


♦/MLS01040 




THEN on,. 




ML SO IC 50 




PIVO =H,. 




MLS0106O 




PIVI =J,. 




MLS01C70 




END,. 




MLS01080 




END,. 




MLSQ109C 






/*TRANSFORM LOWER PART OF 


•/MLSQIIOO 




DC J = 1 TO LK.. 


/•RIGHT HAND SIDE MATRIX 6 


•/"L sonic 




H =0,. 




MLS0112C 




DO I = L TO 


LM.. 


MLsonac 




h =HtMULTIPLV(AI !,L) ,Bn.J),53),. 


MLS3U40 




END,. 




ML so 1150 




MAX* =H/BETa, . 


/♦MODIFY J-TH CCLUMN 


♦/MLS01160 




DO 1 = L TO 


LM,. 


MLSQ1170 




B(I,Jl=e( I,JI-A( I,L)«MAXA,. 


MLS0U8C 




ENO. . 




ML so 1190 




END,. 




MLSQ1200 




EMD, . 


/♦END OF DECOMPOSITION LOOP 


'/MLS0121C 






/«**»**»***** **s*^*(.fte^eK#*«» 


•♦/MLSQ122C 




M J = LN TO 1 BY -1,. 


/•BACKSUeSTITUT ION, INTERCHANGE ♦/MLS0123C! 




DO I = 1 TO LK,. 


/*«**,*f ***,*,*«*«**##, *««**« 


"•♦/MLSei24G| 





H =B(J.H.. 


MLSQ 12 50 




DO L = J+1 TO LN,. 


MLSQ 1260 




H =H-MULTIFLY(AIJ,L1 ,B(L,I),53).. 


•'LS0127C 




END,. 


MLSO1280 




PIVI =P1VIJ),. 


MLSQ129C 




B(J,n=8IPIVl,l),. 


MLSQ130C 




B(PIVl,n=H/AUX( J),. 


MLSQ1310 




ENO.. 


MLSQ1320 


END, 




MLSQ1330 


IF LN LT 


LM /♦COMPUTE LEAST SQUARES 


♦ /MLSQ134'? 


THEN DO J 


= 1 TO LK,. /♦IN CASE OF AN DVERDETERMINEO 


♦/MLSOI350 


H 


=C,. /•EQUATION SYSTEM ONLY 


♦/MLS01360 




DC I = LN*1 TO LM,. 


MLS01370 




H ^HtMULTIPLYIBt I . J) . 61 I , J 1 , 531 . . 


"LS0138C 




END,. 


MLS01390 


B(LM 


,J)=H,. 


«LSQ1400 


END, 




MLSai41C 


END,. 


/♦END OF OPERATION 


• /''LSQ1A20 


END, . 


/•END OF PROCEDURE "LSQ 


*/MLSgi430 



Purpose: 

MLSQ calculates X satisfying AX=B, that is, the 
solution of a system of linear equations using House- 
holder transformations. The least squares solution 
is obtained in case of an overdetermined system of 
equations. 

Usage: 

CALL MLSQ (A, B, M, N, K); 

A(M,N) - BINARY FLOAT [(53)] 

Given coefficient matrix of equation 

system. 

A gets destroyed. 

B(M,K) - BINARY FLOAT [(53)] 

Given matrix of right-hand sides. 
Resultant solution of A'X=B stored in 
upper N rows of B, and if M>N resultant 
square sum of residuals for I-th right- 
hand side stored in elements B(M, I) for 
1= 1, 2, ..., K. 

M - BINARY FIXED 

Given number of equations, that is, num- 
ber of rows of matrices A and B. 

N - BINARY FIXED 

Given number of unknowns, that is, 
number of columns of matrix A and 
number of rows of resultant X, which 
is overlaid with B. 

K - BINARY FIXED 

Given number of ri^t-hand sides, that is, 
number of columns of B. 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 



ERROR='D' means incorrect dimension(s); not all 
of the conditions M>N>0, K>0 are 
satisfied. Operation is bypassed. 
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ERROR='W' means warning, indicating possible 
loss of significance in resultant X. 

ERROR='S' means A has at least one zero- 
column. Resultant X is a least 
squares solution (not necessarily of 
minimal norm). 

ERROR='B' implies both ERROR='S' and ERROR= 
'W; that is, resultant X is a least 
squares solution, but possibly affected 
by loss of significance. 

The internal relative tolerance for test on loss 
of significance is set to 10-5 in single precision 
and to 10-10 in double precision. In the single 
precision version, scalar products are accumulated 
using double precision arithmetic. 

Method: 

A is reduced to upper triangular form, using 
Householder transformations successively. The 
same sequence of transformations is applied to 
given right-hand- side matrix B, Solution X is then 
obtained using backsubstitution. 



The determination of X is based on the reduction of 
the matrix A to an m by n matrix R of the form 



R 



<l) 



by means of an orthogonal transformation Q, so that 
U is an upper tr angular matrix of order n. 

QA = R 

Then, the given equation AX = B can be solved as 
follows: 

QAX = QB 
RX = QB 
X = [U"l O] QB 

if U is of maximal rank (otherwise, see "Program- 
ming Considerations"). It is interesting to note 
that U is the triangular factor provided by the 
Cholesky factorization of A^A. 

A^A = u'^U 



For reference see: 



Householder's transformations 



G. Golub, "Numerical Methods for Solving Linear 
Least Squares Problems" , Numerische Mathematik . 
vol. 7, 1965, pp. 206-216. 

Mathematical Background: 
Notation 



The reduction of the given matrix A to the matrix R 
can be achieved by means of a sequence of (n-1) 
orthogonal transformations the product of which will 
be Q. This can be written as 



.(9) 



The transpose of a matrix A is written as a"*^. The 
k^^ column vector of A is written as A j^ and the 
ith row vector as A^ *. The Euclidean norm of the 



vector R 



^2 



lis abbreviated: 



aW = P« A<^-l),i = l,...,n-l 

where A^ ' is supposed to have the same form as R 
in its first i columns , and where P(i) is an 
orthogonal matrix. Then: 



l|R|l =/ 



r'^r 



i=l 



r. 

1 



Problem 



For a given m by n coefficient matrix A ?ith m s n 
and an m by k matrix B of right-hand sides, an n by 
k matrix X must be calculated that solves AX = B 
in the least squares sense, that is: 



B 



*i 



AX*i 



= min, for j = 1, 2, 



R = A<-1> 



.(i) 



Among the possible matrices P ', let us consider 
those of the form 



p(i) =1 H- „ <') W<^) W<'> ^ 



where I is the unit matrix and w a vector of order m 
related to the scalar aW f^ Ohy 
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It is easy to see that these matrices are orthogonal 
and symmetric. By definition of A(i) , p(i) can be 
written as 



.(i) 



= 1+ 



E^^ (v/^) 



Ji)^ 



(v<^)-g<%.) (v(^)-g«e/ 



Back substitution 

When the matrix is reduced to the triangular form, 
the solution is obtained by back substitution. The 
interchange of rows determined by the pivoting is 
applied to the solution as soon as any component is 
computed. 



where: 



Programming Considerations: 



,(i)T ^ (i) (i) 

^ 1 ' ^2 ' •" 



V. ^ = for j < i 



v(^> = a.<^-^>forJ.i 



m ' 



Ji) 



sign (v. ') 



.(i) 



and where ej is a vector of order m whose compo- 
nents are zero except for the i-th, which is one. 

Actually, neither matrices p(i) nor matrix 
Q = p(n-l) ^^ p(l) ig computed explicitly. 

Each column k of a(^) , k = i, . . . , n, is 
calculated from column k of A(i~^) as follows 



A J^) = aS-1) + 



*k 



*k 



g(i) (v.(i) - g(i)) 



<v 



(i) 



The columns of matrix B are modified in the same 
manner. 

Pivoting 

To keep roundoff errors as small as possible, an 
interchange of columns is performed before the i-th 
transformation, so that the i-th column of A(i~l) gets 
permuted with the k-th for which || v(i) || is maximum, 
k is determined by: 



The procedure may fail if, at any intermediate step 
i, no column with nonzero parameter g(i)can be 
found — that is, if no nonzero main diagonal element 
in U can be generated. In this case, the rank of the 
matrix A is less than n. Because of roundoff errors 
this situation may even occur if the rank of the given 
matrix A equals n. In order to indicate this ill- 
conditioned case, with its possible loss of signif- 
icance, each I g(i) | is compared against a tolerance 
TOL , TOL. is the product of the norm of the cor- 
responding column in the original matrix A times 
the internal tolerance EPS (10~^ in single precision 
and 10" ■'■^ in double precision). 

1. If the relative tolerances TOLj are all positive 
(no zero columns in original A), then ERROR -^ 

'W if I g(i) I > TOLj does not hold true for all 

i = 1, 2 n. Zero elements g(^) get replaced by 

TOLi • 10-10 (TOL • 10-20 in double precision). 

2. If A has zero colimins (corresponding 
TOLj = 0), then ERROR = 'S'. The corresponding 
g<i) is set to IE- 10 or lE-20. 

3. If cases 1 and 2 occur combined, ERROR = 'B'. 
Case 1 indicates possible loss of significance in 

resultant solution X. Case 2 means that X is a 
least squares solution but possibly not the iLniquelv 
determined one of minimal norm. 

For full understanding of the procedure note iiiaJ • 

1. The g(i) 's are recalculated to avoid roundoff 
problems. 

2. The resultant X is overlaid with the given ri 
hand sides. 

3. Least squares deviations are calculated only 
in case m > n, and stored in the last row of the give 
right-hand -side matrix. 



t- 



=f 


= Max (s.^^^ ) 


where: 




V" 


m 
q=i 


;(i-i)- 


2 
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PKUCtUUKE ML5Q CALCULATES THE LEAST 59UARE5 SOLUTION OF AN OVEROET ERHINEO SYSTEM DF SliUL TAIFOUS LINEAR EQUATIONS 



# * 

• PrtUCEOURE HLSa * 
» » 



«#*»» til*** ******* 



***************** 



CI *. 
.* HAS *. 

.*«ArRIX LESS*. 

. ROUS THAN . 

*. COLUMNS .* 

* . -* 



NO 



NUMBER OF *. 
COLUMNS 
.PUSITIVE .* 



61 *. 

.*NUM8ER ». 
NO .* OF RIGHT 
..*. HAND SIDES 
*. PUSITIVE . 



#»***F1*** ******* 
*GENtKArE SCALAR* 
» PRODUCTS OF * 
•COLUMNS IN AUX » 

* AND P IV * 

* * 
»*♦#♦»*********** 



««***G1******«*** 

* PUT INDEX OF * 
•PIVOTCOLUMN IN * 
*PIV1 AND VALUE * 

* IN 5IG * 

* * 
««•«*»*««*«****** 



***** HI*** ******* 



PRESET 
tRROR«'0 



***************** 



*X. 



*****A2********** 

* TOL = PI V(PI VII * 

* SQUARE OF * 
. X* ORIGINAL 

» COLLr-NLENGTH * 

* * 
*«««4*4******«*** 



B2 *. 
.* SHOULD *. 
.* COLUMN BE * 
*. INTERCHANGED 



*****B3********** 

* INTERCHANGE » 
♦SCALAR PRODUCTS* 

.X**NO COLUMNS OF » 
♦LOWER SUBMATRIX* 

* • 
•*♦********♦*♦♦** 



•*««*C2 ********** 

* RECALCULATE * 

* COLUMN LENGTH * 
*T0 REOUCF ROUND* 

* OFF » 

* * 
*4**«44«*****»*** 



#*»**D2********** 

* IF TDL IS * 
*THEN SET ERROR * 

* TO -S' RESP. • 

* 'B', REPLACE * 

* TOL BY 1 * 
*t *************** 



*****^2********** 

* COMP. BETA * 
*( TOLERANCE FOR * 

* LOSS OF * 

* SIGNIFICANCE! • 

* * 
***************** 



* IS SIG * 

EXCESSIVELY 
*. SHALL .* 



•«*«*F3********** 

* SET ERROR TO * 

* "H* RESP. ■ B' * 
X* AND SIG TO * 

* MAX ISIG.BETA) • 

* * 
***************** 



*****Q2********** 

* * 

* FORCE SIGN OF « 
*S!G TO SIGN OF • 

* PI VOTE LE ME NT * 

* * 
***************** 



**t**^2 ********** 

* SAVE * 

* INTERCHANGE « 
*INFORHATION IN *. 

* VECTOR PIV * 
» * 
***«*«♦*********« 



*****B 4** ******** 

* * 

* SAVE AND * 
X* HANSFORH * 

* PIVDTFLFHENT * 

* * 
***************** 



• ♦***C 4»********* 
*TRANSFORM LOWER* 

♦ SUBMATRIX, ♦ 
« UPDATF SCALAR • 

* PRODUCTS * 

* * 
♦♦♦ft************* 



««»**D4^********* 

* SELECT NEXT * 

* PIVOTCOLIWN, * 

* I.E. SIG AND * 

* PIVI * 

* « 
***************** 



*****E4********** 

* * 
*TRANSFORM LOMFR* 

* PART OF RIGHT * 

* HAND SIDES * 

* * 
ftftftftft************ 



FA 



*. 



****J3********» 

* END OF « 
.X*PROCEDURE ML5Q 'X. 

♦ • 
*************** 



IS *. 

* OECOMPO- * 

SITION LOOP 

*. COMPLETE .* 

*. .* 

*. .* 

* YES 



*****GA*»******»* 

* COMP. ROWS OF * 

* LEAST SQUARES * 

* SOLUTION BY * 

* BACK- * 

* SUBSTITUTION * 
***************** 



ftftftftftHA********** 

* * 

* RE INTERCHANGE * 

* COMPUTED * 

* SOLUTION * 

* ♦ 
ft«*«ftft *»***« ***** 



JA *. 

.* HAS *. 
NO .»MATRIX MORE*. 
...*. ROWS THAN . 
*. COLUMNS .* 



*****K 4*»**»***** 

* * 
*CALCULATE LEAST* 

.* SQUARES * 

* RFSIOUALS * 

* * 
ftft ft ft** ft* *«***«**♦ 
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• Subroutine MGB1/MGB2 



MGBl.. 






MGP 


10 


/***************************(, »*<.*,♦«*« 


****«*.«<,***«««***«****#*# tt**ft**#/pQfl 


2C 


/* 






*/MGB 


30 


/» FOP AN FOUATION SYSTEM 


A*X = i: 


WITH BAND MATRIX A=L*U 


*/MGB 


40 


/* CALCULfiTE CPTIONtLLV 






*/MG8 


50 


/• OPPER TRIANGULAR FACTOR 


U AND SOLUTION X, 


♦ /MGB 


60 


/« UPPEP TRIANGULAR FACTOP 


U AND INVERSE1LI*R, 


*/MGB 


70 


/* INVERS£IU)*R FOR GIVEN U 


,R. 


*/MG6 


80 


/* 






*/MGB 


90 


/**««*«»«»*#««]|<««««««**t^***« «««««**(, 


******************************»: 


*«/MGB 


100 


PROCEDUBElA,«;,N,NLD,NUD,M,ePStGPT) 


, . 


MGP 


lie 


DECLARE 






MGB 


120 


ERROR EXTERNAL CHARACTGftd), 


/^EXTERNAL ERROR INDICATOR 


*/MGB 


130 


C^PT.COPTI CHAKACTERin 






MGB 


140 


EPS BINARY FLOAT, 






MGB 


15C 


SUM BINARY FL0AH53), 






MGB 


160 


{A(*,*t,Rl«,*),L(«I.SHN),OIV 


,W} 


MGB 


170 


BINARY FLOAT, 




/^SINGLE PRECISION VERSION /* 


S*/MGB 


160 


/* BINARY FLCAT(53t , 




/*OOUBLE PRECISION VERSION /* 


D«/MGB 


190 


(1PER<*I,I,IBAC,IN0,!NL 


IPIV, 




MGB 


200 


J.K.KL.LM.LLM,LN,LNLO,LNUO,M, 




MG? 


21C 


N,NB,NLD,NUO) 






MGB 


220 


BINARY FIXED,. 






MGB 


23r 


INO =1,. 






MGP 


240 


SO TO BOTH,. 






MGB 


2 50 


MGB?.. 






MGB 


26C 


/**»***m***m****f****t***t*******t^*if 




**/MGe 


27C 


/* 






*/MGB 


280 


1* FOR AN EQUATION SYSTEM 


A*X = P 


WITH BAND MATRIX A=L*U 


• /MGB 


290 


/* COMPUTE OPTIONALLY 






*/MGB 


300 


/• TRIANGULAR FACTORS 


L,U 


POSSIBLY COMBINED WITH 


*/MG6 


31C 


/* CALCULATION OF X OR I NVERSE ( L 1 *Rt 


«/MGB 


320 


/* INVEPSE1L)*R OR INVcfi SE( A ) *P FOR GIVEN L,U,fi. 


*/MGB 


330 


/* 






*/MGB 


340 


/******4******t«* *************** t*tH/if**f#»!:HHi^***t************^****** 


**/MGB 


350 


ENTRY(A,R,L, 1PER,N tNLO,^UD,M 


EPS, OPT),. 


MGB 


360 


!ND =2.. 






MGP 


370 


BOTH.. 






MGB 


380 


LN =N,. 




/*STOPE VARIABLES N, M, NUD, 


*/MG6 


39C 


IM,LLM=«*,. 




/*NLD FROM CALLING SEQUENCE 


*/MGB 


400 


LNUO =NUD,. 




/«INTO LOCAL PARAMETERS 


• /MGB 


410 


LNLD =NLD,. 






MGB 


420 


ERROR='P'.. 




/*P MEANS WRONG INPUT 


• /MGB 


43C 


IF LM LE 




/*VALUE M MUST BE POSITIVE 


*/MGB 


440 


THEN GO TO RETURN,. 






MGB 


45C 


IF LNLO LT 




/•NUMBER OF LOWER COOIAGPNALS 


• /MGB 


460 


THEN GO TO RETURN,. 




/*NLO MAY NOT BE NEGATIVE AND 


«/MGB 


470 


IF LNLO GE LN 




/♦EQUAL TO OR GREATER THAN N 


*/MGB 


480 


THEN GO TO RETURN,. 






MGB 


490 


IF LNUO LT C 




/•NUMBER OF UPPER CODIAGONALS 


*/MGB 


50C 


THtN GO TO RETURN,, 




/*NUO MAY NOT BE NEGATIVE AND 


*/MG6 


51C 


If LNUO G6 LN 




/•EQUAL TO OR GREATER THAN N 


*/MGB 


520 


THEN GO TO RETURN.. 






MGB 


530 


ERROR=»0' ,. 




/•PRESET ERROR INDICATOR 


*/MGB 


540 


NB =LNUD+LNLD*l,. 




/•CALCULATE THE NAXINUH WIDTH 


*/MGB 


550 


IF NB GT LN 




/*0F BAND MATRIX 


♦/MGB 


560 


THEN NB ='LN,. 






MGB 


570 


IBAC =1,. 




/•IBAC IS AN INDICATOR FOR 


♦/MGB 


580 


KL «0,. 




/•BACK SUBSTITUTION 


*/HGB 


590 


COPT =OPT,. 






MGB 


600 


IF COPT= 'A' 




/•CALCULATE INVERSEIL) * R 


♦/MGB 


610 


THEN DO,. 




/•FOR GIVEN L» U, R 


*/MGB 


620 


INO =0>. 






MGB 


630 


IBAC -0,. 






MGB 


640 


GO TO GAUSS, 






MGB 


650 


END,. 






MGB 


660 


IF COPT= 'B* 




/♦CALCULATE INVERSEIUt * R 


«/M66 


670 


THEN GO TO BACK,. 




/•FOR GIVEN U, R 


♦/MGB 


680 


IF COPT= •€• 






MGB 


690 


THEN DO,. 




/•CALCULATE INVERSE(A) • R 


♦/MGB 


TOO 


IND =0,. 




/•FOR GIVEN L* U« R 


•/MGB 


710 


GO TO GAUSS*. 






MGB 


720 


ENO,. 






MGB 


730 


IF COPT= 'L' 




/•COMPUTE TRIANGULAR FACTOR U 


♦ /MGB 


740 


THEN DO,. 




/•AND OPTIONALLY L AND 


♦/MGB 


750 


IBAC =0,. 




/•CALCULATE INVERSEIL) * R 


♦/MGB 


760 


GO TO SCAL,. 




/•FOR GIVEN A, R 


♦ /MGB 


770 


END,. 






MGB 


780 


IF COPT* 'F' 




/•COMPUTE TRIANGULAR FACTORS 


•/MGB 


790 


THEN DO,. 




/•L AND U FOR GIVEN MATRIX A 


♦/MGB 


800 


IBAC =0,. 






HGB 


810 


LLH =0,. 






MGB 


820 


GO TO SCALf. 






MGB 


830 


ENO, . 




/•COMPUTE TRIANGULAR FACTOR U 


♦/MGB 


840 


IF COPT= "U* 




/•AND INVERSE(U)*R FOR GIVEN 


♦/MGB 


850 


THEN LLM "0,. 




/•A, R 


*/MGB 


860 






/• 


♦/MGB 


870 


SCAL.. 




/•CALCULATE SCALING FACTORS 


♦/MGB 


880 






/• 


*/MGB 


890 


K -LNUO,. 




/•K IS AN END INDICATOR FOR 


•/MGB 


900 


INL =LNLDtLN-N6+l,. 




/•EACH ROW OF MATRIX A 


♦/MGB 


910 


IPIV =NB-LNUD,. 






MGB 


920 


DO I =1 TO LN,. 




/•EXECUTE LOOP OVER ALL RONS 


♦/MGB 


930 


IF I LE IPIV 






MGB 


940 


THEM K =K*1,, 




/•IN I-TH ROM THE ELEMENTS 


♦ /MGB 


950 


IF I GT INL 




/•A(I,K+l) TO AtltNBI ARE 


♦/MGB 


960 


THEN K =K-1,. 




/•FILLED UP KITH ZEROS 


♦/MG8 


970 


PIV =0,. 






MGB 


980 


00 J =1 TO NB,. 




/•EXECUTE LOOP OVER I-TH ROM 


•/MGB 


990 


IF J GT K 






MGB 


1000 


THEN AII,J)=0,. 




/•FILL UP WITH ZEROS 


*/MGB 


1010 


ELSE 00,. 






MGB 


1020 


W =ABS(AU 


J)),. 


/•COMPUTE ABSOLUTELY GREATEST 


♦/HGB 


1030 


IF W GT PIV 




/•ELEMENT PIV IN I-TH ROW OF A 


•/MGB 


1040 


THEN PIV -H, 






MGB 


1050 


END.. 






MGB 


1060 


END,. 






MGB 


1070 


IF PIV= C 




/♦TEST FOR ZERO-ROW 


•/MGB 


1080 


THEN 00,. 




/•ALL ELEMENTS IN I-TH ROW OF 


•/MGB 


1090 


ERRCR='S',. 




/•GIVEN MATRIX A ARE ZERO 


•/MGB 


1100 


GO TO RETURN,. 






MGB 


1110 


END,. 




/•STORE THE RECIPROCAL IN THE 


•/MGB 


1120 


SL( I»*1/PIV,. 




/•VECTOR SL 


*/MGB 


1130 


END,. 




/***********»***************** 


**/MGB 


1140 


GAUSS.. 




/•GAUSS ELIMINATION 


• /MGB 


1150 


DO I =1 TO LN-1,. 




/********.****************.******* /)HQQ 


1160 


INL =I*LNLO,, 




/*INVERSE(L)^R 


•/MGB 


1170 


IF INL GT LN 






MGB 


IIBO 


THEN INL =LN,. 






MG9 


1190 





IF IND= r 


/•NO FACTORIZATION 


♦/MGB 


1200 




THEN 


00,. 


/•CALCULATE INVERSEIL) * R 


♦/MGB 


1210 






IPIV =IPER(n,. 


/♦FOR GIVEN L, U, R 


*/MGB 


1220 






GO TO INTR,. 




MGB 


1230 






END,. 




MGB 


1240 




M 


=0,. 


/♦INITIALIZE W FOR PIVOTING 


*/MGB 


1250 






DO J =1 TP INL,, 




MGB 


1260 






PIV =ABS(AiJ,l))*SL( J) , 


./^MULTIPLY ELEMENTS WITH SCALE 


♦ /HGB 


1270 






IF PIV GT M 


/^FACTORS AND SEARCH GREATEST 


*/MGB 


1280 






THEN DO,. 


/•PRODUCT 


• /MGB 


1290 






W =PIV.. 




HGB 


1300 






IPIV =J,. 


/♦STORE ROW INDEX 


♦ /MGB 


1310 






END,. 




HGB 


1320 






END,. 




MGB 


1330 




IF W 


LE ABS(EPSI 


/•TEST FOR LOSS OF S IGN IF ICANCE^/MGB 


1340 




THcN 


IF W = 


/♦ANO FOR ZERO 


♦ /HGB 


1350 




THEN 


00,. 




MGB 


1360 






ERROR=' S' ,. 


/♦NEXT PIVOT IS ZERO POSSIBLY 


*/MGB 


1370 






GO TO PETUPN,. 


/♦DUE TO LOSS OF SIGNIFICANCE 


♦/MGB 


1380 






END,. 




MGB 


1390 




ELSE 


ERROR='WS. 


/♦W MEANS WARNING 


• /MGB 


1400 




PIV 


=fl(lPlV,l),. 


/♦PIV CONTAINS THE PIVOT 


• /MGB 


1410 




IF IN0= 2 


/•STORE INFORMATION FOR ROW- 


• /MGB 


1420 




THEN 


IPERm=IPIV,. 


/♦PERMUTATIONS 


• /MGB 


1430 




IF !PIV= I 


/♦IS INTERCHANGE NECESSARY 


*/MGB 


1440 




THEN 


GO TO FSUB,. 




MGB 


1450 




SLUPIV) = SL1 U,. 


/♦RESTORE SCALING ELEMENTS 


*/MGB 


1460 






DO J =1 TO NB,. 




MGB 


1470 






W =A(1,J).. 


/♦INTERCHANGE ROWS IN GIVEN 


*/MGB 


1480 






A(I, J) = A(IPIV,J),. 


/•MATRIX A 


*/HGB 


1490 






A( IPIV,J)=H,, 




HGB 


1500 






END,. 




MGB 


1510 


INTR.. 








MGB 


1520 






OD J =1 TO LLM,. 


/♦INTERCHANGE ROWS IN RIGHT 


• /MGB 


1530 






W =RII,JI,. 


/♦HAND SIDE MATRIX R 


• /MGB 


1540 






Rn,J>=R(lPlV,J»,. 




MGB 


1550 






RUPIV,J»=W,. 




MGB 


1560 






END,. 




MGB 


1570 


F5UB.. 






/•MODIFY OPTIONALLY ROWS IN 


• /MGB 


1580 






DO J =1+1 TO INL,. 


/♦MATRIX A AND IN RIGHT HAND 


•/MGB 


1590 






IF iND= 


/♦SIDE MATRIX R 


• /MGB 


1600 






THEN 00,. 




MGB 


1610 






KL =KL*1,. 




MGB 


1620 






W =-L(KLI,. 




MGB 


1630 






GO TO DIVL,. 




HGB 


1640 






END,. 




HGB 


1650 






W =A(J,1»/BIV,. 


/•W IS AN ELEMENT OF THE LOWER 


*/MGB 


1660 






IF INO= 2 


/•TRIANGULAR FACTOR L 


• /MG9 


1670 






THEN 00,. 




MGB 


1680 






KL =KL+1,. 




MGB 


1690 






L(KLJ=W.. 


/♦STORE W INTO L IF REQUESTED 


*/HGB 


1700 






END,. 




HGB 


1710 






DO K =2 TO NB,. 


/•MODIFY AND SHIFT ROWS OF A 


•/MGB 


1720 






A( JTK-n-At J,K}-M*A( I ,K) ,. 


MGB 


1730 






ENO,. 




MGB 


1740 






A( J.NB)=0,. 


/•LAST TERM IS SET TO ZERO 


• /MGB 


1750 


OIVL.. 






/♦MODIFY ROWS OF R TO COMPUTE 


•/MGB 


1760 






DO K =1 TO LLH.. 


/•INVERSEILI^R 


•/MGB 


1770 






R(J,K)=R(J,K)-W»R1I 


,K),. 


MGB 


1780 






ENO,. 




MGB 


1790 






ENO,. 




MGB 


1800 




ENO, 






HGB 


1810 


IF INO= 2 






HGB 


1820 


THEN 


IOER(LN)=LN,. 




MGB 


1830 


IF IBAC NE 1 




MGB 


1840 


THEN 


GO TO RETURN,. 


/*****««********«**«*««*********/HGB 


1850 


BACK.. 






/♦8ACKSUBSTITUTI0N 


•/MGB 


1860 




00 I 


-LN TO 1 BY -I,. 


/************:***************** 


♦♦/HGB 


1870 




PIV 


=A(I,11,. 




MGB 


1880 




IF PIV= 


/•TEST FOR ZERO PIVOT 


• /MGB 


1890 




THEN 


DO.. 




MGB 


1900 






ERROR='SS. 


/•PIVOT ELEMENT IS ZERO 


♦ /MGB 


1910 






GO TO RETURN,. 




MGB 


1920 






END,. 




MGB 


1930 




INL 


=1-1,. 




HGB 


1940 






DO J =1 TO LM,. 


/♦LOOP OVER ALL COLUMNS OF R 


*/MGB 


1950 






SUM =R(I,J),. 




HGB 


1960 






DO K *2 TO IBAC. 


/•CALCULATE SCALAR PRODUCT 


*/MGB 


1970 






SUM =SUM-MULTIPLY(A(I,KI,RIINL*K,J),53),. 


MGB 


1980 






ENO,. 




MGB 


1990 






RU,J)-SUM/PIV,. 


/♦COMPUTE NEW ELEMENT IN R 


*/MGB 


2000 






END,. 




MGB 


2010 




IF IBAC LT NB 




MGB 


2020 




THEN 


IBAC =IBAC*1,. 


/•UPDATE END OF INNERMOST LOOP 


• /MGB 


2030 




END, 






MGB 


2040 


RETURN. 








MGB 


2050 


ENO, 






/♦END OF PROCEDURE MGB 


♦ /MGB 


2060 



Purpose: 

MGBl performs the following operations on an 
equation system A • X = R with general band 
matrix A = L • U, depending on the character of 
an input parameter OPT: 



OPT = 'L' 
OPT = 'U' 
OPT = 'B' 
otherwise 



U replaces A and L~1r 

replaces R 

U replaces A and U~^R 

replaces R 

U~ R replaces R for a given 

U on storage locations of A 

U replaces A and the solution 

X = A-1r replaces R 
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The following table shows input and output depending 
on OPT: 



MGBl - OPT 


'L' 


'U' 


•B' 


otherwise 


INPUT 


A 


R 


A 


R 


U 


R 


A 


R 


OUTPUT 


U 


L-^R 


U 


U-^-R 


U 


U-^R 


U 


A-^-R 



Usage: 

CALL MGBl (A, R, N, NLD, NUD, M, EPS, OPT); 

A(N, NB) - BINARY FLOAT [(53)] 

Given N by N band matrix A con- 
sisting of the main diagonal, NLD 
lower codiagonals, and NUD upper 
codiagonals, A is stored rowwise 
and left-adjusted so that A(i, 1) con- 
tains the first nontrivial element in 
the i-th row of matrix A, i = l, 
2, ..., N. Thus, the maximum 
number of elements in the rows of 
array A is: 

NB = min (N, NLD + NUD + 1) 
Resultant upper band factor U stored 
rowwise and left-adjusted so that 
A(i, 1) contains the diagonal element 
in the i-th row of the upper factor 

U, i=l, 2 N. If OPT='B', 

A contains U. 

R(N, M) - BINARY FLOAT [(53)] 

Given right-hand-side matrix with N 
rows and M columns, which implies 
that M sets of right-hand- side vec- 
tors are given. 

Resultant solution depending on the 
option parameter OPT (see 
"Purpose"). 

N - BINARY FIXED 

Given row dimension of matrix A 
and number of rows of right-hand 
side R. 

NLD - BINARY FIXED 



NUD 



M- 



EPS - 



OPT 



Purpose: 



Given number of lower codiagonals 

of matrix A. 

BINARY FIXED 

Given number of upper codiagonals 

of matrix A. 

BINARY FIXED 

Given number of columns of R, that 

is, number of right-hand-side vectors. 

BINARY FLOAT 

Given relative tolerance for test on 

loss of significant digits. 

CHARACTER(l) 

Given option parameter for selection 

of operation (see "Purpose"). 



MGB2 performs the following operations on an 
equation system A- X= Rwith general band ma- 
trix A = L . U, depending on the character of an 
input parameter OPT: 

OPT = ' L' A is replaced by upper band factor 
U, R is replaced by L"-*- • R, and 
lower band factor L is stored in 
a one-dimensional array L omit- 
ting the unit diagonal. 

OPT = ' p A is replaced by the upper band 

factor U and the lower band factor 
L is stored in the array L. The 
right-hand side R remains un- 
changed. 

OPT = ' A' R is replaced by L"!* R for the 
given upper factor U in array A 
and the lower factor L in vector 
L. 

OPT = 'C' R is replaced by the solution 
X = A~^- R for given U and L. 

otherwise A is replaced by the upper factor 

U. The lower factor L is calcu- 
lated and stored in L, and R is 
replaced by the solution 
X = A-1. R. 

The following table shows input and output depending 
on OPT: 



MGB2 - OPT 


'L' 


'F' 


'A' 


'C' 


otherwise 


INPUT 


A 




R 


A 




R 


U 


L 


R 


U 


L 


R 


A 




R 


OUTPUT 


U 


L 


L-^R 


U 


L 


R 


U 


L 


L-l.R 


u 


L 


A-l-R 


U 


L 


A-^.R 
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Usage: 

CALL MGB2 (A, R, L, IPER, N, NLD, NUD, M, 
EPS, OPT); 

A(N, NB) - BINARY FLOAT [(53)] 

Given an N by N band matrix A con- 
sisting of the main diagonal, NLD 
lower codi agonal s, and NUD upper 
codiagonals. A is stored rowwise and 
left-adjusted so that A(i, 1) contains 
the first nontrivial element in the i-th 
row of matrix A. Thus, the maxi- 
mum number of elements in the rows 
of the array A is: 

NB = min (N, NLD + NUD + 1) : 
Resultant upper band factor U stored 
rowwise and left-adjusted so that 
A(i, 1) contains the diagonal element 

in i-th row of U, i = 1, 2 N. 

If OPT='A' or'C, the array A 
contains U. 
R(N, M) - BINARY FLOAT [(53)] 

Given right-hand-side matrix with N 
rows and M columns, which implies 
that M sets of right-hand-side vectors 
are given. 

Resultant solution depending on the 
option parameter OPT (see 
"Purpose"). 
L(N. NLD- NLD. (NLDf l)/2) 

BINARY FLOAT [(53)] 
Resultant one-dimensional array con- 
taining the lower factor L. If OPT = 
'A' or 'C, array L contains the 
lower factor L, obtained by sub- 
routine MGB2 with any other option 
parameter. 
IPER(N) - BINARY FIXED 

Resultant integer vector containing 
the permutations of rows of the ma- 
trix A in the factorization steps. 
If OPT= 'A» or 'C, permutation 
vector IPER must be given, obtained 
by MGB2 with OPT= 'A', 'C. 
N - BINARY FIXED 

Given row dimension of matrix A and 
number of rows of right-hand side R. 
NLD - BINARY FIXED 

Given number of lower codiagonals 
of the matrix A. 
NUD - BINARY FIXED 

Given number of upper codiagonals 
of the matrix A. 
M - BINARY FIXED 

Given number of columns of R, that 
is, number of right-hand- side vectors. 



EPS- 



OPT- 



Remarks: 



BINARY FLOAT 

Given relative tolerance for test on 

loss of significant digits. 

CHARACTER(1) 

Given option parameter for selection 

of operation (see "Purpose"). 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR='P' means error in specified parameters: 
M s or NLD < or N ^ NLD 
or NUD < or N :S NUD 

ERROR='S' means all elements in a row of the 
given matrix A are zero, or the 
calculated pivot in a factorization 
step is zero. This is possibly due to 
an ill-conditioned or singular matrix 
A. 

ERROR='W' is a warning indicating possible loss 
of significance. , 

The storage mode for band matrices is a natural 
generalization of the normal two-dimensional 
storage scheme: any row is stored with N&:min 
(N, NLDH+NUD) elements, but only the nontrivial 
elements (that is, those within the band) must be 
specified. The remaining elements are set to zero 
automatically within procedure MGB1/MGB2. 

Note that a fully populated N by N matrix would 
require exactly N • N storage locations if stored as 
band matrix in compressed form. However, the 
unit lower triangular factor L would need additional 
N • (N-l)/2 storage locations. 

Method: 

Calculations of the lower and upper band factors L, 
U are done using a standard Gaussian elimination 
technique. Columnwise pivoting is built in, com- 
bined with scaling of rows (equilibration). 

The lower band factor L is normalized such that 
the diagonal contains all ones, which are not stored 
(Doolittle factorization). 

The procedure gets the required solutions by 
means of forward and/or backward substitutions, 
where the interchange information is combined with 
the lower band factor L. 

For reference see: 

R.S. Martin and J.H. Wilkinson, "Solution of 
Symmetric and Unsymmetric Band Equations on the 
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Calculation of Eigenvectors of Band Matrices", 
Numerische Mathematik . vol. 9, 1967, pp. 279-301. 

Mathematical Background: 

Let A be an N by N nonsingular real band matrix 
with NLD lower codiagonals and NUD upper codiag- 
onals. In general, it can be factorized into a 
product 

A= P- L' U 

where L and U are lower and upper band factors 
respectively. L can be normalized so that it has a. 
unit diagonal. P means the row-permutation matrix, 
that is, an N by N unit matrix with interchanged 
rows resulting from partial pivoting in the factoriza- 
tion steps. _ 

Then X= L"^. P"^. R= L"l R is calculated 
using forward substitution to obtain X from L • X * 
P"^' R = R, where R is obtained from R by inter- 
changing rows in the same way that rows of matrix 
A are interchanged during columnwise pivoting in 
factorization. 

Calculation of Y = U"^. R is done using backward 
substitution to obtain Y from U* Y=R. _ 

Calculation of Z = U"^- L-^._P-1. R = U"-^' L'^- R 
is done by first solving L* X = R and then solving 
U. Z = X. 

Programming Considerations: 

1. Storage Mode 
The following is an example of a 7 by 7 matrix with 
two lower and three upper codiagonals which shows 
the storage compression of band matrices and the 
storage allocation of upper and lower triangular 
factors U and L. 

Fully stored matrix: 



Compressed stored band matrix; 





Elements marked X need not be specified. They get 
filled up with zeros automatically. 

Resultant upper triangular factor U and unit lower 
triangular factor L: 



11 12 13 14 15 16 



"22 "23 



u u 

25 26 



U= 



33 34 35 36 



"44 "45 "46 "47 
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The band-shaped upper triangular factor U is stored 
rowwise and left-adjusted, so that A(i, 1) contains 
the diagonal element for i = 1, 2, . . . , N, The 
band-shaped lower unit triangular factor L is 
stored in a one-dimensional array. Only the non- 
trivial subdiagonal elements are stored columnwise 
in successive storage locations. 

2. Computational remarks 
In order to improve numerical stability, partial 
pivoting is used combined with an equilibration of 
rows. In each row i of the given matrix A the 
element a«. of greatest absolute value is found . 
The absolute values Vi= 1/ jay. I are used as 
weights for pivoting: 

At the first step of Gaussian elimination that 
element a^i is used as pivot element piv for which 



kl 



max 
i=l,., 



(a,, 



, NLD+1 



^i) 



If necessary, rows k and 1 are interchanged in A, 
R and V = ^1 \ and IPER(l) is set to k. 



\Tn/ 



The elements in the first NLD rows are trans- 
formed by means of 



1. 



= ail 



11 


piv 




""■i-'ii 


ik 


- 'ik - ■■ 



Ik 



i = 2,..., NLD+1 



j =2 NB 



k = 1 M 



If specified, the elements 1q are stored in 
successive locations within L. 

Transformed rows of A get shifted to the left 
by one position, and zero is inserted in the last 
location. 

Repeating this process (N-1) times gives 
triangular factors U and L and the product L~ R, 
in permuted form. 

If at an elimination step the value of piv be- 
comes zero, then ERROR is set to 'S' and further 
calculation is bypassed. 

ERROR is set to ' W if, at elimination step j , 
V. • piv s EPS. 
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FUR AN EQUIIQN SYSTEM A*X=R WITH BAND MATRIX A=L»U 

MGBl CPTIONALIY CCfPUTFS X, U» INV PPSFIL )»R, INVfRSF(U)*R 
MC82 CPTIGNAILY COI-PUTES X, U, INV ERS E (L )*R, AND L 



• *** 

* * 

* AA * 

* ♦ 



* * 

* A5 • 

* ♦ 



****A1****«**** 
*Pt<UCtDURE MGdl * 
.* icT INU^l * 
* * 



* ENTKY MGb2, * 

* t>R£oET IN0=2 * 

* * 
*«««««««4< ****** 



.*IS NLD *. 
.♦GtiEAT. THAN*. NO 
" , Uk = AND .*,,, 
*.LfcSS THEN.* 



.*1S NUD ». 
YEi ,*GR£AT. THAN*. 
...*. OH = AND .» 
• .LESS THAN.* 



****G1*** ****** 

* END OF * 

* PSOCEDURE MGfl * 

* * 



***»«H1*** ******* 
*StT ERROR ='0',* 

♦ COMPUTE MAXIMUM* 

♦ 8AN0-WIDTH NB, ♦ 
*SEr IBAC=1 FOti ♦ 

♦ BAUiUBSTITUT, * 



.*. 

Jl *. 
.* IS *. 

.* QPT='A', * 

.I.E. COMPUTE 
♦ ,INV(L)*R .* 



A2 *. 
. • IS 4. 

. # aPT = 'F ', *. YSS 
*.I.E. COMPUTE .*,... 
*. FACTORS .* 
*. Li U . * 
». . * 
* NO 



. * GPT=»U', *. YFS 
.I.E. COMPUTE .*.... 
*.IKVIU) *R .« 
».ANO U. * 



* ♦♦♦^A"}********** 

* SWITCH OFF * 

* INDICATOR FOR * 
X» BACK- * 

* SUBSTITUTinN, * 

* IBAC=0 * 



* SET LOCAL VALUE* 

* FOR NUMBFR OF * 
.X* CCLUMNS OF R *. 

* LLM=0 * 

* * 



aOTh X 


. *. 






mi^*v*Ci*********9 










.* IS '*. 






*PARAMETERS INTO* 


. * QPT='B S 


♦ 


YPS 


* LOCAL ONES, * 












* 












«*»*»«««* 41 *»«*«»« 










* KD 




**** 

* 
• G5 




'. 





02 
.• IS 



^ - - - * SWITCH OFF * 

•,* 9'^^^X\il.*,.r.*'J^^ * INDICATOR FOR • 

.I.E. COMPUTE .* X* BACK- * 

♦.INV(L) •«,.* * SUBSTITUTION, * 

♦. L,U .* * IBAC=0 * 

♦. . ♦ *«*****•*****»*«* 
♦ NO 

*X 



.* OPT='C«, *. YFS 
.t.t. COMPUTE .*.... 
•,INV(A)*R .* 



*i^***^2 ********** 

* INSERT ZEROS * 

* INTC TWO * 

* TRIANGULAR * 
*ARFAS OF 61 VEN * 

* fATRU A * 
f **************** 



«««»*F2 ********** 

* CALCULATE * 

* ABSOLUTELY * 

* GREATEST TERM * 
*PI V IN EACH RCW* 

* OF A * 
***************** 



G2 *. 
.•TEST *. 
. » FOR ANY *, NC 

* .ZERO-ROW, I.E..*... 

♦. I S ANY . • 
♦. PI V=0. * 
♦. . * 
♦ YFS 
**** 

* * . 

* H2 *. X. 

* ♦ . 
**** 

X 

* ♦**»H2 »•***#♦«♦» 

* • 

* SET ERROR * 
.* PARAMETER, ♦ 

* ERROR='S» * 



*****J2********** 

* SWITCH OFF * 

* INDICATOR FCR * 
X* BACK- * 

* SU8STITUTI ON, * 

* IfiAC=0 ♦ 
*********** t««*** 



♦***«K2 **«•**»♦•* 
*SET |N0=0, I.E.* 

• THE TWO • 
.X* TRIANGULAR ». 

♦FACTORS L AND U* 

* ARE GIVEN * 
***************** 



* STORE THE * 

* RECIPROCAL OF * 
X* EACH PIV IN * 

* VECTOR SL » 

* * 

*************t*tti: 



* F3 *,X. 

* * 
*♦♦* 

GAUSS X 

*****fi*******: 
♦INITIALIZE 1= 
*AS LCGP COUNT 

..X* FCR GAUSS 

* ELIMINATION 



♦ ** 
1 » 
ER* 



******* 



********* 



• *. 
G3 *. 

.♦TRIAN- ♦. 
♦GULARS L.U ♦. YES 

ARF GIVEN, .*.... 
*. I.E. .* 

*. rND=0.* 
*. .* 
* NO 



*****HJ********** 

* MULTIPLY * 

* ELEMENTS W IT H ♦ 

* CORRESPONDING * 

* SCALE FACTORS • 

* * 
***************** 



***** j^********** 

♦ SEARCH * 

♦ ABSOLUTELY * 

♦ GREATEST ♦ 

♦ PRODUCT AND * 
♦STORE IT INTO W» 
***************** 



*****K3********** 



***************** 



-* TEST *. 
NO .*FD^ LOSS OF*. 
,..». SIGNIFICANT . 
*.niGITS IN.* 



*****Ci,* ********* 



***************** 



t****Oit********** 

*STnRE INFOOMA- * 

* TIO-J FOR i^OM * 
♦PERMUTATIONS IF* 

* RFQUESTFD I .E. * 

* IN0=2 * 
***************** 



*****f t,********** 

* INTERCHANGE ♦ 
♦SCALE ELEMENTS * 

* ANfl ROMS IN « 
*GIVE'< MATRIX A * 

* » 
***************** 



INTR X 

*****(;it********** 

* INTFRCHANGF * 

* ROWS IN R BY • 
...X«MEANS OF A LOOP* 

*0'= 1 UP TO LLM * 

* (LLM=M OR 0) * 
***************** 



H4 *. 
.•TRIAN- *. 
.*GULARS L.U 
. ARE GIVEN, 
*. I.E. 
*.INO=n.* 



». 



NO 



*****^ it********** 
♦CALCULATE TFRMS* 

* OF LOWER * 

* TRIANGULAR « 

* FACTOR L * 

* ♦ 
***************** 



*■****< i,********** 

* STORE TERMS * 

* IMTO L IF * 
♦RFPUFSTEO I.F. * 

* IND=2 * 

* • 
***************** 



**t**fii^i^ ********* 

• TRANSFORM AND * 
♦SHIFT a MAXI I^UM* 
♦OF NLD ROWS CF * 

• A, ",IV1NG * 

• MATRIX U * 
***************** 



*****QC, if******** 

* SET LAST TERf * 



***************** 



^IVL X 

*****C5 ********** 
♦TRANSFORM RCWS ♦ 
*nc R WI TH LCOP • 

.. X* FROM 1 UP TO * 
*LLM (=M OR 0) , * 
♦INCREASE 1 = 1*1 ♦ 
***************** 



*****E 5 ***«*•**•* 

*STORE I WORM- • 

* TION FCR RCH * 
•PERMUTATIONS IF* 
♦REOUFSTEO I.E. ♦ 

• I ND=2 ♦ 
**************^t* 



. *. 

F5 *. 

.* WITH ♦. 

. ♦BACKSUBSTI-*. 

.TUTION, I.E. . 

*.IS IBAC=1.* 



* G5 •.X. * 

* * . 
**** 

.BACK X 

*****(i^ ********** 
♦INITIALIZE I=N ♦ 
♦AS LOOP COUNTER* 

* FOR BACK- * 

* SUBSTITUTION • 

* * 
***************** 



H5 *. 

. * TEST ♦. 

. * FOR ZERO *. YES 

.X*.PI VOT IN l-TH.*.... 

♦.ROW, !.£.,• 

" PIV=0.* 



*. 



* NO 



*****JS********** 

•TRANSFORM TERMS* 
*IN l-TH ROW CF * 

• R Gl VI NG * 

* INVERSE(U) *R, ♦ 
•DECREASE 1=1-1 * 
***************** 



K5 *. 

. *I S LOOP*. 

NO .* COUNTER I ♦, 

. ..*. LESS THAN .» 

*. ONE .• 

*. . * 



* A2 • 

* • 
•*«« 



• * 

• A4 * 

• * 



* * 

* A5 * 

* * 



..X* Gl * 
♦ • 

• «•« 
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Eigenvalues and Related Topics 

Note : The following example illustrates a way to 
link subroutines MATE, MEAT, MVAT, MVEB 
(which follow) for the computation of the eigenvalues 
and eigenvectors of a real nonsymmetric matrix. 
(Subroutines MATE and MVEB can be replaced with 
MATU and MVUB. ) 

Description of the parameters used: 



N- 



Real array containing the given matrix 
(this matrix is not preserved) 
Order of the matrix 



H - Real array in which the Hessenberg matrix 
will be saved together with the elements of 
the transformations involved in subroutine 
MATE 

CH - Complex array containing the Hessenberg 
matrix for the computation of the eigen- 
vectors 

EV - Complex array where the eigenvectors are 
stored 

The other parameters are defined in the descrip- 
tions of the subroutines. 

All the eigenvalues are assumed to be complex in 
this example, so tiiat only N/2 eigenvectors are 
computed. 



/* 
/* 



MAIN PROGRAM 
BEGIN BLOCK 



/* 
/* 
/* 
/* 

/* 



/* 
/* 



BINARY, 

COMPLEX BINARY, 
BINARY FIXED, 
BIT(l). . 
GENERATE THE MATRIX * / 

REDUCTION TO HESSENBERG FORM * / 
SAVE HESSENBERG MATRIX * / 
COMPUTE THE EIGENVALUES * / 

COMPUTE N/2 EIGENVECTORS * / 



N=50, . 

BEGIN, . 
DECLARE 

(A(N, N) , RR(N) , RI(N) , H(N, N)) 
(CH(N, N) , EIG, EV(N, N/2)) 
(IP(N),I,J,K,M) 
ANA(N) 
CALL GEN(A,N), . 
CALL MATE(A,N,IP), . 
H = A, . 

CALL MEAT(A,N,RR,RI,ANA), . 
1 = 0, . 

DO M = 1 TO N BY 2, . 
1 = 1+ 1, . 

EIG=COMPLEX(RR(M) , RI(M)) , 
CH(1,*)=H(1,*), . 

DO J = 2 TO N, . 

D0K=J-1 TON, . 
CH(J,K)=H(J,K), . 
END, . 
END, . 
CALL MVAT (CH,N,EIG,EV(*,I)), . / * EIGENVECTORS OF THE 

/ * HESSENBERG MATRIX 
CALL MVEB(H,N,IP,EV(*,I)), . / * VECTORS OF THE GIVEN MATRIX 
END, . 

PUT EDIT / * PRINT THE RESULTS 

END, . / * END BEGIN BLOCK 

.... / * MAIN PROGRAM 



PUT THE HESSENBERG MATRIX 
INTO A COMPLEX ARRAY 



*/ 

*/ 



*/ 
*/ 



*/ 

*/ 
*/ 

*/ 
*/ 



Note tiiat the eigenvalues of the original matrix A are equal to the eigenvalues of the corresponding 
Hessenberg matrix, so that no back transformation of the eigenvalues is required. 
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• Subroutine MATE 



Remarks; 



MATE.. 


MATE in 


/*****************************ti^^tit********************t***t***********/HAJB 20 


/* 


*/MATE 30 


/* REDUCE A REAL MATRIX TO HESSEN8ERG FORM 


*/MAT6 40 


/* ELIMINATION TECHNIQUES 


♦/HATE 50 


/* 


*/MATE 60 


/*********9*****m****************t***********09i-**m****»**^iLt*********/HAJE 70 ' 


PROCEDURE(A,N.IP»,. 


MATE 80 


DECLARE 


MATE 90 


IAt«»*).CtU,V) 


MATE 100 


BINARY, 


MATE 110 


S 


MATE 120 


BINARY153), 


MATE 130 


(N,IP(*>,K,KPl,Kl,M,I,J,Nn 


MATE 140 


BINARY FIXED*. 


MATE 150 


IF N LT 3 THEN GO TO EMATE,. 


MATE 160 


IP(N)=N.. 


MATE 170 


Nl=f*-1,. 


MATE 180 


DO K=N1 TO 1 BY -1,. 


MATE 190 


KPl=K+l,. 


MATE 200 


Kl=K-l,. 


MATE 210 


N=K,. 


MATE 220 


U=ABS(AIKPI,K)),. 


HATE 230 


00 1=1 TO Kl,. /* PIVOTING 


*/MATE 240 


V=A8S(A(KP1,I)),. 


MATE 250 


IF V GT U 


MATE 260 


THEN DO.. 


MATE 270 


U=V.. 


MATE 280 


H=-I,. 


MATE 290 


ENDt. 


MATE 300 


END,. 


MATE 310 


IP(K>=Mt. 


MATE 320 


IF M NE K 


MATE 330 


THEN DO.. /* INTERCHANGES 


•/MATE 340 


DO 1=1 TO N,. /* COLUMNS 


*/MATE 350 


C'-Ad.Kt.. 


MATE 360 


At I,K)>A(I,M).. 


MATE 370 


A(I.M)=C.. 


MATE 380 


END.. 


MATE 390 


00 1=1 TO N.. /* ROWS 


♦/MATE 400 


C=A<K.n.. 


MATE 410 


AIK.I)=A(H.I>,. 


MATE 420 


A(M.II'C(. 


MATE 430 


END.. 


MATE 440 


END.. 


MATE 450 


IF A<KP1.K) NE 


MATE 460 


THEN DO I-l TO Kl.. /* COEFFICIENTS OF ELIMINATION 


♦/MATE 470 


AlKPl.n-AUKPl.D/AlKPl.K),. 


MATE 480! 


ENO,. 


MATE 490 


DO I»N TO 1 BY -1.. /* K-TH ROW OF THE HESSENSERG 


*/HATE 500 


S-A(K.I>«. /* MATRIX 


♦/MATE 510 


DO J=l TO Kit. 


MATE 520 


S=S+HULTIPLYtAIKPl.J},A(J.I).53l.. 


MATE 530 


END.. 


HATE 540 


00 J=MAX(I*1.K1 TO Nl.. 


MATE 550 


S>S-HULTIPLY(A(K.J).AIJ«l,IltS3),. 


MATE 560 


END.. 


MATE 570 


AIK.I)=S,. 


MATE 580 


ENO*. 


MATE 590 


END.. 


MATE 600 


EMATE.. 


MATE 610 


RETURN,. 


MATE 620 


ENO.. /• ENO OF PROCEDURE MATE 


♦/MATE 630 



Purpose: 

MATE reduces a given real matrix to upper almost 
triangular (Hessenberg) form by means of a se- 
quence of similarities. 

Usage: 

CALL MATE (A, N, IP); 

A(N, N) - BINARY FLOAT 
Given real matrix. 

Resultant upper almost triangular ma- 
trix. 

N - BINARY FIXED 

Given order of the matrix. 

IP(N) - BINARY FIXED 

Resultant vector containing information 
about the interchanges operated on rows 
and columns of the matrix. 



The elements defining the transformations applied 
to the matrix are stored in place of the lower tri- 
angular part of the matrix on return. These ele- 
ments and the vector IP will be used in the com- 
putation of the eigenvectors of the original matrix 
(Procedure MVEB). 

Method: 

Each row of the matrix is reduced in turn, starting 
from the last one, by applying a suitable elimination, 
and similarity is achieved by applying the left 
inverse transformation. A Crout-like algorithm is 
used to take advantage of the accumulation of the 
inner products In double precision. 

For reference see: 

J. H. Wilkinson, The Algebraic Eigenval ue Prob- 
lem, Clarendon Press, Oxford, 1965. 

Mathematical Background: 

Let us consider a matrix A of order n and the 
similarity 



TAT""^ = H 



(1) 



where H Is a Hessenberg matrix associated with A, 
and T a lower triangular matrix with unit diagonal. 
Equation (1) can be written as 



TA= HT 



(2) 



Matrices H and T will be determined row by row, 
according to the algorithm described below. 

If rows (k+1) to n of H and rows k to n of T are 
assumed to be known, row k of H and row (k-1) of 
T will be determined as follows. 

From equation (2) we get 

k-1 n 

a, . = Z) t, . a.. = h, . + X) h, . t.. 
kl . , k] 11 kl . .^ , k] ji 
j=l ■" 3=1+1 •" •• 



and 



k-1 



h, . = a, . + S t, . a.. - J2 h, . t.. 
kl kl .^^ kj ]i .j^^^ k] 31 



(3) 
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If we apply equation (3) for i = n, n-1 k, 

we will obtain recursively the terras of the k-th 
row of H, excepting the subdiagonal terra. 
(When the upper bound of a sumraation is less 
than the lower bound, the value of the sum is 
taken as zero.) 

Let us determine now the (k-l)st row of T and 
the subdiagonal term 



\ k-1 °^ "• 



From equation (2) we get 

k-1 n 

a, . + 2-< t, . a.. = X) h, . t.., 
ki . , k] 11 . , , k] 11 
3=1 •■ j=k-l •• ■' 



l=si<k-l 



Defining 



k-1 



^ Vn ^1^ - ^ K, ^.' l^i^k-l (4) 



When m, . = for i = 1, . 
ki 



, k-1, h = and 



t, , .= for i = 1 k-2. 

k-1 1 

Programming considerations: 

1« The interchanges determined by the pivoting 
are stored in vector IP. This vector will be used 
in the computation of the eigenvectors (subroutine 
MVEB). 

2. The matrix T is stored in the lower part of 
the array A, overwriting the terms of the original 
matrix: 

tj^j-A (I+l, J), 2«IsN-l, KJsl-1 

These elements tj^ j will be used in the computation 
of the eigenvectors (subroutine MVEB). The last 
row and the diagonal of T are not stored. 

3. The inner products involved in equations (3) 
and (4) are computed in double precision. 



ki ki .^^ kj ]i .^1^ k] ji 



we finally obtain 



m 



\k-i = "^kk-i' Vii 



ki 



kk-1 



-, lsi<k-2 



(5) 



To ensure stability, a technique of pivoting is in- 
corporated in this algorithm. 

After the computation of the nij^j's, the sub- 
script j is determined for which 



k] 



m 



ki 



l^i^k-l 



Then the elements mj^j and mj^ j^_j are interchanged. 
So are columns j and (k-1) of T. Similarly, the 
columns and the rows of matrix A are also inter- 
changed. Then equations (4) and (5) are applied. 
The algorithm is initialized by taking 

h =a 
nn nn 



m . = a . 
ni ni 



t . =0 
ni 



t =1 
nn 



l^i<n-l 
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• Subroutine MATU 



HATU.. 


MATU 10 


/«**««««*««***««*: 4<****it<«*****»«*«*«««*«««******>l>****««****««**«**«iK« 


**/HATU 20 


/* 


*/MATU 30 


/♦ REDUCE A REAL MATRIX TO HESSENBERG FORM 


♦/MATU 40 


/* HOUSEHOLDER'S TRANSFORMATIONS 


♦/MATU 50 


/* 


•/MATU 60 


/mm******************m************************************************/nAl\J 70 | 


PROCEDURE (A*N,B)«. 


MATU 80 


DECLARE 


MATU go 


(AI*,*),B(*I,£PS,T,C,U) BINARY, 


MATU 100 


5 B1NARYI53). 


MATU 110 


(I.J.K,KPLtKP2,N) BINARY FIXED.. 


MATU 120 


EPS=1.0E-14. . 


MATU 130 


BUI >0*. 


MATU 140 


00 K-1 TO N-2t. 


MATU 150 


KPl -K*l,. 


HATU 160 


KP2 =KPl*l.. 


MATU 170 


S -Ot. /* PREPARE K-TH TRANSFORMATION 


«/MATU 180 


DO I-KP2 TO N,. 


MATU 190 


S«S«^MULTIPLY(A(IiKI,AII*K)»53),. 


MATU 200 


END,. 


HATU 210 


r -A(KP1,K)*A«KP1.K),. 


HATU 220 


IF S GT EPS*T 


HATU 230 


THEN DO,. 


MATU 240 


S =SQRTIS+T1,. 


HATU 250 


T »S,. /* CHOOSE SIGN FOR STABILITY 


*/HATU 260 


IF AIKP1,K) GT THEN T=-T,. 


MATU 270 


C *A(KPl.K)-t,. 


MATU 280 


00 J-KPl TO N). /* ROW OPERATION 


*/HATU 290 


S >0,. 


HATU 300 


00 I=KP1 TO N,. 


MATU 310 


S*S+NULTIPLY(A(I,J)tA(I,K).53)*. 


HATU 320 


END,. 


MATU 330 


U =AIKP1,J),. 


HATU 340 


AIKP1,J1=S/T,. 


HATU 350 


U «tAlKPl,J)-U)/C,. 


HATU 360 


00 I=KP2 TO N,. 


HATU 370 


A1I,J)-A(I,J)+U*A(I«K>,. 


MATU 380 


END,. 


HATU 390 


ENO,. 


HATU 400 


00 J=l TO N,. /• COLUMN OPERATION 


*/HATU 410 


S «0,. 


HATU 420 


DO t=KPl TO Nt. 


MATU 430 


S-S+MULTIPLYIA<J,I),AII*K),53),. 


HATU 440 


END,. 


MATU 450 


U -AIJrKPlI,. 


HATU 460 


A(J,KPl)-S/T,, 


MATU 470 


U =tAIJ.KPl>-U)/C,. 


MATU 480 


DO I=KP2 TO N,. 


HATU 490 


A(J,I1*AIJ,I)«U*A(I,K),. 


HATU 500 


END,. 


MATU 510 


END*. 


MATU 520 


BIKPl)>AIKPi,K),. 


HATU 530 


ACKPl,K»=T,. /• TRANSFORM SUBOIAGONAL TERM 


♦/MATU 540 


END.. 


MATU 550 


ELSE BIKPD-O,. /* BYPASS K-TH TRANSFORMATION 


*/MATU 560 


END,. 


MATU 570 


RETURN, , 


MATU 580 


ENO., /* END OF PROCEDURE MATU 


•/MATU 590 



matrix on return. These elements and the vector 
B will be used in the computation of the eigenvectors 
of the original matrix (Procedure MVUB). 

Method: 

Each column of the matrix is reduced in turn by 
means of orthogonal similarities (Householder' s 
tr ansf ormations) . 

For reference see: 

J. H. Wilkinson, The Algebraic Eigenvalue Problem , 
Clarendon Press, Oxford, 1965. 

Mathematical Background: 

For a given real matrix A of order n, let us con- 
sider the sequence of similarities 



a(^*^)=P.a(^)p.-^ = 1. 2. 
with A^^ = A 



,n-2 



(1) 



Assuming that A^^) is of almost triangular form in its 
first (i-1) columns, we will determine a trans- 
formation Pj such that Av^"*"-"-' is of almost triangular 
form in its first i columns. Among the matrices 
Pj, let us consider those of the form 



Purpose: 

MATU reduces a given real matrix to upper almost 
triangular (Hessenberg) form by means of a sequence 
of orthogonal transformations. 

Usage: 

CALL MATU (A, N, B); 



A(N,N) 

N- 
B(N)- 



BINARY FLOAT 

Given real matrix. 

Resultant upper almost triangular 

matrix. 

BINARY FIXED 

Given order of the matrix. 

BINARY FLOAT 

Resultant vector containing information 

about the transformations applied to 

the original matrix. 



P. = I - 2 u u (Householder's matrices) (2) 



where I is the unit matrix and u a vector of order n 
such that 



<u, u> = 1 



(3) 



These matrices are orthogonal and symmetric, and 
equation (1) can be written as 



,(i+l) 



P. A<'> P. 
1 1 



Let us now define a vector v by 
T 



V = (v^, v^, 



•V' 



with 



Remarks: 



V, = for k = 1, 2, 
k 



. 1 



(4) 



Other elements defining the transformations are 
stored in place of the lower triangular part of the 



v, = a , . for k 
k k, 1 



i + 1, 
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and try to determine the transformation P. so that 

1 



• Subroutine MSTU 



1/2 
P. V = be. , where b = ± < v, v> (5) 

11+1 ^ 



ej+j is a vector whose components are zero, 
except for the (i+1) st which is one. 

The combination of equations (2) and (5) gives 



P. v = v-2<u, v>u 
1 



= be 



i+1 



Putting < u, v> = s, u is given by 



V - be. 



u = 



i+1 



2s 



From equation (3) we get 



s = b (b - v.^^)/2 



Then the matrix Pj can be written as 



P- = I + T7~^ Tx (V - be.^ J (v - be.^ j'^ 

1 b(v. , -b) ^ 1+1' ^ 1+1' 

1+1 



The sign of b will be such that the magnitude of 
the denominator is maximum, that is. 



sign (b) = - sign (v.^^) 



in order to ensure stability. 

If we now form the product PjA^*), the resulting 
matrix, according to (5), will have zeros in posi- 
tions (k, i), k = 1 + 2 n, and the term in 

position (i+1, i) will be b. The (i-1) first columns 
and rows remain unaltered. 

The right transformation (PjA^^') Pi, completing 
the similarity, will leave this structure unchanged. 
Thus, after (n-2) transformations according to (1) 
and (4) , the matrix will be reduced to almost 
triangular form. 

When the matrix is symmetric, it is interesting 
to note that the resulting almost triangular form is 
symmetric also (that is, tridiagonal) . 



MSTU.. 








MSTU 10 


/«*»««***«*«* 


^^^t:tVt****'lt***********<***'************ 


»«**«*:«# 


«**•«**»« 


*«/MSTU 20 










•/MSTU 30 


/« REDUCE A COMPReSSEO SYMMETRIC MATFIX TO SYMMETRIC TftID[flGONAL FORM*/MSTU 4C | 










«/MSTU 50 


/«♦#*«**»*••**«»**«*•********»•»**«**«»*******»»*••••***»•* 




••/MSTU 60 


PROCEDURE 


(A.N.O.COl,. 






MSTU 70 


OeCLAPE 








MSTU 80 


(A(* 


,D(«),CDI*),T,EPS1 eiNACY, 






MSTU 90 


fN,N2,ICO.MP2,M,HP.J,I,L.LK,K) BINARY FIXEC 


, 




MSTU 100 


(S,OT) 8INARYt53),. 






MSTU no 


N2 =H-2 








MSTU 120 


IF N2 LE THEN GO TO EMSTU, . 






MSTU i30 


D( 1) =A( 1 








MS7U l-VO 


EPS =1.0E-14, . 






MS'^U 15C 


ICD =C,. 








MSTU 160 


HP2 =2.. 








MSTU 170 


00 M 


1 TO N2,. /* COMPUTE NEM SUBDIAGONAL TEF 


M*/MSTU U'.v 


MP 


=MP2,. 






MSTU 190 


HP 2 


=MP+1». 






MSTU 20C 


ICO 


=1C0*MP,. 






MSTU ?1C 


J 


=ICD,. 






MSTU 220 


S 


=0,. 

DO I=-:MP2 TO N,. 

J =J+I-1.. 

0(1) =A(J).. 

S=S+MULT!PLY(Om,D(I )t53l ,, 

END, . 






KSTU 230 
WSTU 2*0 
MSTU 250 
MSTU 260 
MSTU 270 
MSTU 2 80 


T 


=A(ICD)«A1ICD),. 






MSTU 290 


IF S 


GT T*EPS THEN GO TO TRANS.. 






MSTU 300 


COIM) = AUCO).. /* BYPASS 


TBANSFOPMATION 


«/MSTU 310 


GO TO BYPASS,. 






MSTU 320 


TRANS.. 








MSTU 330 


COIM)=SORT(S*T),. 






MSTU 3*0 


IF ACICDJ GT THEN COIMl =-Cr( M) , . 






MSTU 350 


0(MP)-A(ICDI-CD(M1,. 






MSTU 360 


J 


=ICD-M,. 






MSTU 370 


DT 


=0,. /* COMPUTE 


VECTORS 


DEFINING 


*/MSTU 380 




00 L=MP TO Nt. /♦ THE TRANSFORMATION 


♦/MSTU 390 




J =J+L-l,, 






MSTU AOO 




S '■O,. 






MSTU 410 




LK =J,. 






MSTU 420 




DO K=MP TO L,. 






MSTU 430 




LK =:LK+l,. 






MSTU 44C 




S=StMULTIPLY(A(LKt,0(K),53),. 






MSTU 450 




END,. 






MSTU 460 




DO K=L*1 TO N,. 






MSTU 470 




LK =LK*K-1,. 






MSTU 480 




S=S+MULTIPLY(A(LK),D(K1,53»,. 






MSTU 490 




END,. 






MSTU 500 




DT =DT+S*D(L),. 






MSTU 510 




CD(L)=S,. 






MSTU 520 




END,. 






MSTU 530 


OT 


=C.5*DT,. 






MSTU 540 


T 


=D(MP)*CO(M),. 
00 L=MP TC N,. 
DID =D(L)/T,. 
CDIL)=CD(L)+DT»0(L),. 

END,. 






MSTU 550 
MSTU 560 
MSTU 570 
MSTU 580 
MSTU 590 


J 


=ICD-M,. /* PERFORM SIMILARITY 


*/MSTU 600 




DO K=MP TO N,. 






MSTU 610 




J =J*-K-1,. 






MSTU 620 




LK =J,. 






MSTU 63C 




DO L=MP TO K,. 






MSTU 640 




LK =LK+1,. 






MSTU 650 




S =AILK(,. 






MSTU 660 




S=S+MULTIPLYIO(L) ,C0( K) ,53 J+MULT I PLY I D( K 


, COIL), 53), -MSTU 670 | 




a(LK)=S, . 






MSTU 680 




END,. 






MSTU 690 




ENO, . 






MSTU 7CC 


BYPfiSS.. 








MSTU 710 


DCiP 


=fl(icD+n,. 






MSTU 720 


fNO, 








MSTU 73C 


ICD =ICD 


N, . 






MSTU 740 


CD(NI=fl( ICDI ,. 






MSTU 750 


DIN) =A(ICOtl)t. 






MSru 760 


00 J 


N-1 TO 2 6Y -1,. 






MSTU 770 


CD( J 


=CD( J-l) ,. 






MSTU 780 


END, 








MSTU 790 


co(n=c, . 








MSTU 800 


EMSTU.. 








MSTU 810 


RETURN, . 








MSTU 820 


END, . 


/* ENO Of 


PROCEDURE MSTU 


*/MSTU 630 



Purpose: 

MSTU reduces a given real symmetric matrix to 
tridiagonal form by means of a sequence of 
orthogonal transformations. 

Usage: 

CALL MSTU (A, N, D, CD); 



Programming Considerations: 

A transformation P. for which I Vj.^.j + b I <10~'^ | b | 
is bypassed. All the scalar products involved in 
tile computation are calculated in double precision. 



A(N*(Nf l)/2) - BINARY FLOAT 

Given matrix in compressed storage 

mode. 
N - BINARY FIXED 

Given order of the matrix. 
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D(N) 



CD(N) 



BINARY FLOAT 
Resultant vector containing the 
diagonal terms of the tridiagonal 
matrix. 

BINARY FLOAT 

Resultant vector containing the co- 
diagonal terms of the tridiagonal 
matrix in positions 2, 3, . . . , N. 



Remarks: 



The elements defining the transformations applied 
to the matrix will replace the given matrix in array 
A. These elements will be used in the computation 
of the eigenvectors of the original matrix (subroutine 
MVSU). 

Method: 

Each row and column of the matrix is reduced in 
turn by means of orthogonal similarities (House- 
holder's transformations). 

For reference see: 

J. H. Wilkinson, The Algebraic Eigenvalue 
Problem . Clarendon Press, Oxford, 1965. 

Mathematical Background: 

We know that a matrix A of order n can be reduced 
to almost triangular form by means of (n-2) suc- 
cessive unitary similarities (see description of 
subroutine MATU). Furthermore, when A is 
symmetric, these transformations preserve the 
property of symmetry, and the resulting matrix is 
symmetric and tridiagonal. Let us consider the 
sequence of such similarities that reduces A to 
the tridiagonal form A^*^" '. 



A(i-l) = p. aW p., a(1) 
1 1 



1, 2, . . . , n-2 



A, 



where AW is assumed to be of tridiagonal form in 
its first (i-1) rows and symmetric, and where Pj is 
the Householder matrix such that A^^"*" ^ is of tri- 
diagonal form in its first i rows. We know that Pj 
is defined by 



P. = I + 
1 



1 T 

r— — (v - be. ,) (v - be. ,) 

b(v. -b) ^ i+l' ^ i+l' 

^ i+1 ' 



where: 



V =(v,, v^. 



. V ) 

n 



V = 0, for k = 1, 2 i 



k,i 



V = a . , for k = i+1, . . . , n 



1/2 



b = ± < V, V > , sign (b) = - sign (v. 



i+1) 



and where ej+i is a vector whose (i+l)st compo- 
nent is one, the others being zero (see mathematical 
description of subroutine MATU). 

Putting X = V - be._^ and o = fb (v. - b)l ~^ , 
we have 

P.A«P. ^A^^^aA^xx^^+axx^A^ 



2 (i) T 

+ a < x, A^ ' X > XX 



,(i) 



+ [a<^)x + 



1/2 < X, A^ ^ TO- 



(i) 



axj a; 



r T .(i) 
a X I X A^ 



+ 1/2 



< X, A^ x>fy X J 

(i) (i)T 
Since A' = A , this can be written as 



P.A^^^ P. = A^^^ + YZ^ + Zy'^ 
1 1 



where 



Y = [a^^^ + _a < X, A^^^ X > l] 



(1) 



(2) 



Z = ax 

Programming Considerations: 

In the subroutine each similarity is performed on 
the upper part of the matrix according to equations 
(1) and (2). 

The scalar products needed by the process are 
computed in double precision. 
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• Subroutine MEAT 



MEAL. 



EIGENVALUES OF A REAL HESSEN6EBG MATRI 



MEAT 

VMEAr 
♦/MEAT 

PROCEDURE (A,H,RR,R|,ANA}» 
DECLARE 

ANA(*) eiTU», 

... ,, ... -pa.Ipa.iT.IIHAX.J.K.N.Nl.NZ.P.Q.Ml BINARY FIXED, .HEAT 120 



♦••••♦•/HEAT 
"EAT 
HEAT 
HEAT 



(I>I1,I2.IPI 
-l.OE-6, . 
•l.OE-7,. 
=1.06-12,. 
=0.5,. 
ITMAX-30,. 



E6 
E7 
E12 



N 



Nl 



=H, 



-N-l, 



/• 



CONSTANTS 



INITIALIZATION 



If N1=0 THEN GO TO ONE,. 
=0,. 

DO 1-1,2,. 

PAN(I),PRRIII,PRI(I|.o,. 
END,. 
-Nl-1, . 

00 IT-1 TO ITHAX,. /* START LOOP FnR ITFBATinM 

IF ABSIA.N.NU. LE E12.ABS( AIN.N) ) THEN GO ?o oS". 



=AIN1,N1I-A<N,NI 
u =T*T, . 

V -4«AIN1,NI*A(N,N1I,. 
IF ABSIV) LT U^ET 
THEN 00,. 

RR(N1)=A(N1,N1I,. 

RRIN) =A(N,Nt,. 

GO TO zin,. 

END,. 
ELSE 00,. 

T -U+V,. 

IF ABS(T) LT E6«HAX(U,ABSIV)I THEN I-O,. 
U •(A(Nl,Nll«A(N,N))/2,. 

=SQRTIABSlTll/2,. 



ROOTS OF THE LOHER HAIN 
SUBHATRIX OF ORDER TUO 



COMPLEX ROOTS 



IF T LT 

THEN DO,. /* 

RRIH1,RR<N1I=U,. 

RIIN)=-V,. 

RI(N11=V,. 

END,. 
ELSE DO,. /* 

RRIN1=U+V,. 

RR(NI)=U-V,. 



RIIN>.RI(N1I=0,. 

IF ABSIRRINlll LI ABSIRR(NI) 

THEN OO,. 

T •RR(Nl),. 

RR(N1)=RR(N),. 
RRINI=T,. 
END,. 
ENO,. 
END,. 
IF N2-0 THEN GO TO TWO,. /• TESTS OF CONVERGENCE 

EPS ■E12^(RI(N1I»ABS(RR(N1I11,. 
IF ABSIA(NI,N2)) LE EPS THEN GO TO TMO,. 

IF ABSIAIN1,N2)-PANI11) LT ABSIAIN1,N2I l«e6 THEN GO TO CHP, 
IF »BSIA(N,N1I-PANI2)I LT ABSI AIN,N1I ■•E6 THEN GO TO CHP,. 



DETERHINE THE SHIFT 



=0, 

DO 1=1,2,. 

J-I4N2, . 

IF ABSIRRIJ)-PRRIIII>ABSIRIIJI-PRI(I|| 

LT H^IABS<RRIJII»ABS(RI(J)11 THEN K=K*I 
PRRd )=RR( J),. 
PRIII1=RI(J1,. 
PAN(II«A(J,J-U,. 
END,. 



-AIN,NI«AIN1,N1I,. 
=A(N,N)»AIN1,N1)-A1N1,NI»AIN,NI), 



IF K=0 




THEN R,S 


=0,. 


ELSE IF K 


-3 


THEN 


00,. 




s 




R 




END. 


ELSE 


DO,. 




R 




S 




END, 


IF N LT 4 




THEN P.Q 


-It. 


ELSE 00,. 





-PRRIK)«PRRIK),. 
'^PRRtKj+PRRU},. 



SEARCH FOR A PARTITION 



DO Q«N2 TO 2 BY -I,. 

IF AeS<A(Q,Q-l)) LE EPS THEN GO TO FOP,. 
END,. 
Q =1,. 

IF Q LT N2 

THEN 00 P=N2 TO Q*l BY -1,. 

IP! ='P*l,. 

IF tAB5IAIP,P|+ACIPL,IPl|-S)«AeSlA(IPlM,IPin) 
*ABS(A(P,P-l)*A(IPl,P)) 



♦/MEAT 130 
MEAT 140 
MEAT 150 
HEAT 160 
HEAT 170 
HEAT 
•/MEAT 190 
HEAT 200 
MEAT 210 
MEAT 220 
HEAT 230 
MEAT 240 
MEAT 250 
MEAT 260 
♦/MEAT 270 
MEAT 280 
♦/MEAT 290 
♦/MEAT 300 
MEAT 310 
HEAT 320 
HEAT 330 
HEAT 340 
MEAT 350 
MEAT 360 
HEAT 370 
HEAT 360 
NEAT 390 
HEAT 400 
MEAT 410 
MEAT 420 
HEAT 430 
♦/HEAT 440 
HEAT 450 
HEAT 460 
MEAT 470 
HEAT 480 
♦/MEAT 490 
HEAT 500 
HEAT 510 
MEAT 520 
MEAT 530 
HEAT 540 
MEAT 550 
HEAT 560 
HEAT 570 
MEAT 580 
MEAT 590 
MEAT 600 
HEAT 610 
♦/MEAT 620 
MEAT 630 
HEAT 640 
MEAT 650 
HEAT 660 
MEAT 670 
♦/HEAT 680 
MEAT 690 
MEAT 700 
MEAT 710 
MEAT 720 
MEAT 730 
MEAT 740 
HEAT 750 
HEAT 760 
MEAT 770 
MEAT 780 
MEAT 790 
MEAT 800 
MEAT 810 
MEAT 820 
HEAT 830 
MEAT 840 
HEAT 850 
MEAT 860 
♦/MEAT 870 
HEAT 880 
MEAT 890 
MEAT 900 
MEAT 910 
MEAT 920 
MEAT 930 
HEAT 940 
HEAT 950 
HEAT 96Q 
MEAT 970 
MEAT 980 
MEAT 990 



l;Vn'*Tn*S!i*'*'*'***'*"*'''*"^****'*»''*^***'IPl»''>*'" M6ATIO00 



THEN GO TO QRT, 
ENO 



IPX 
IP2 



END,. 

=p ro Nl, 
= i*i.. 
*ipi+i,. 
=1-1,. 



START QR TRANSFORMATION 



IF I=P 

THEN 00,. / 

&1 =A(I.I)^(A(I,1}-$)*AI 
G2 -A(IPl.n«|AIIPl,IPl)+Aa,Il-S^ 
63 =A(IP1,I1^ A(IP2,IP1),. 
A<[P2.I)=0.. 
ENO,. 

ELSE 00,. 

61 >A(I,I1|,. 

62 >A(IP1,I1|,. 
IF I 6T N2 
THEN 63 =0,. 



MEAT 1010 
MEAT 1020 
MEAT 1030 
MEAT 1040 
MEAT 1050 
/MEAT 1060 
MEAT 1070 
MEAT 1080 
MEAT1090 
MEATllOO 
INITIALIZE TRANSFORMATION ♦/MEATlllO 
IPU^AIIPl.n+R,. MEAT1120 

MEAT1130 
MEAT1140 
HEAT1150 
MEAT 1160 
HEAT 1170 
MEAT1180 
MEAT 1190 
MEAT 1200 
MEAT 12 10 



ELSE G3 =AIIP2,I1),. 

END,. 
U =SQRT(G1*6U62^62*63^G3),. 

IF U=0 
THEN 00, . 

PHI -2,. 

PSI1,PSI2=0,. 

END,. 
ELSE DO.. 

IF Gl LT THEN U=-U,. 

T =G1*U,. 

PSIl =G2/T,, 

PSI2 =G3/T,. 

PHI =2/ll4-PSIl^PSIl+PSI2^PSI2) 

ENO.. 
IF 1=0 THEN GO TO ROW,. 
IF I=P THEN An.Ill = -ACI,Il).. 
ELSE A)I,IU=-U,. 



ROW OPERATION 



ENO 
IF I LT Nl 
THEN K 
ELSE K 



00 J=I TO N,. /♦ 

T -PSn^ACIPUJl.. 

IF I LT Nl THEN T=T*PSI2^A( IP2. JI , . 

ETA =PHI*IT+A(I,J)»,. 

AIi,Jl=A(I,J|-ETA,. 

A(IP1,J)=AIIP1,J1-PSI1^ETA,. 

IF I LT Nl THEN AnP2, Jl = Al IP2, J (-PSI2+ETA 



COLUMN OPERATION 



00 JsQ TO K,. 

T -PSIl^AtJ,IPl),. 

IF I LT Nl THEN T-T»PSI2^AIJ , IP21 , . 

ETA =PHI^(T*A(J,I)»,. 

A(J.I|=AtJ,l|-ETA,. 

A(J,IP1|.A(J,IPI)-ETA^PSI1,. 

IF I LT Nl THEN AIJ , IP2».AIJ, IP2)-ETA^PSI2, 
IF I LT N2 
THEN 00, . 

IP3 =IP2+1,. 

ETA =PHI^PSI2^A1 IP3,IP2),. 

A(IP3,I)— ETA,. 

A ( I P3 , I PI l=-eTA*PSI I, . 

A(IP3.IP2)>A(IP3,iP2)-ETA^PSI2,. 



ENO, 
END,. 
END,. 
IP.. 
IF ABSIA(N,N1)) GT ABSl A( Nl,N2) ) 
THEN 
0.. 

00,. 

ANAIN1)=*1*B,. 

ANA<N)>*0'B,. 



00,. 

ANAIN)«iI'B,. 

RRIN) <AIN*N),. 

RUN) >0.. 

N =NI.. 

END,. 
IF N GT THEN GO TO 6E6. . 
RETURN. . 
ENO,. 



MEAT1220 
HEAT 1230 
MEAT1240 
HEAT1250 
HEAT 1260 
MEAT1270 
HEAT1280 
MEAT 1290 
MEAT 1300 
MEAT1310 
MEAT1320 
MEAT 1330 
HEAT 1340 
MEAT1350 
HEAT1360 
MEAT1370 
HE AT 1380 
MEAT 1390 
HEAT 1400 
♦/MEAT1410 
HE AT 1420 
HEAT1430 
HEAT 1440 
HEAT 1450 
MEAT 1460 
HEAT1470 
MEAT 1480 
♦/HE ATI 490 
HEAT 1500 
MEAT 1510 
MEAT 1520 
MEAT 1530 
MEAT 1540 
MEAT 1550 
HEAT1560 
MEAT 1570 
MEAT 1580 
ME AT 1590 
HEAT1600 
MEAT1610 
MEAT1620 
HEAT1630 
MEAT1640 
HEAT1650 
MEAT1660 
HEAT 1670 
♦/HEAT 1680 
♦/MEAT 1690 
HEAT 1700 
MEAT1710 
HEAT1720 
MEAT 1730 
♦ /MEAT 1740 
♦/MEAT 1750 
HEAT1760 
MEAT1770 
MEAT 1780 
MEAT1790 
HEAT 1800 
/•ONE EIGENVALUE HAS BEEN F0UN0*/M6AT1810 
MEAT1820 
MEAT 1830 
MEAT 1840 
HEAT1850 
MEAT1860 
MEAT 1870 
MEAT1860 
♦/MEAT 1890 



ENO QR TRANSFORMATION 
END LOOP OF ITERATION 



TWO EI6ENVALUES HAVE BEEN 
FOUND 



ENO OF PRKEOURE MEAT 



Purpose; 

MEAT computes the eigenvalues of a real upper 
almost triangular matrix (Hessenberg form — 
see subroutines MATE and MATU) using the double 
QR iteration. 

Usage: 

CALL MEAT (A, M, RR, RI, ANA); 

A(M,M) - BINARY FLOAT 

Given almost triangular matrix. 

M - BINARY FIXED 

Given order of the matrix. 

RR(M) - BINARY FLOAT 

Resultant vector containing the real 
parts of the eigenvalues. 

RI(M) - BINARY FLOAT 

Resultant vector containing the imagi- 
nary parts of the eigenvalues. 

ANA(M) - BIT(l) 

Resultant vector containing information 
for checking the results (see "Program- 
ming Considerations", below). 
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Remarks: 

The original matrix is destroyed. 

Method: 

Double QR iteration of J. G. F. Francis 

For reference see: 

J. G. F. Francis, Computer Journal, October 1961, 
4-3; January 1962, 4-4. ~ 

J. H. Wilkinson, The Algebraic Eigenvalue Problem , 
Clarendon Press, Oxford, 1965. 

Mathematical Background: 

1 . Definition of the QR iteration 

Let A be a real or complex nonsingular matrix of 
order n. Then a decomposition of A exists of the 
form 

A = Q R 

where Q is unitary and R is upper triangular. If 
the diagonal elements of R are real and positive, Q 
is unique. Consider now the sequence of matrices 
A^P' defined recursively by 



,(0) 



A, a(p)=q(P)r(P\ 



a<p-'^)=r(pVp>p:^o. 



,(P+1) 



q(P)* ^(P) q(P) for p > 0; hence. 



Note that A 

A^P' is similar to A for all p. 

Furthermore, if A satisfies certain conditions, 
it can be proved that A^P' tends to an upper triangu- 
lar matrix as p -* "^ ; thus the eigenvalues of A are 
the diagonal elements of this limit matrix. 

2. Convergence 

If the moduli of the eigenvalues are distinct, the 
elements a(?^ below the main diagonal of A^P) tend 
to zero, as do | ^ i | P/ 1 X j | P, the eigenvalues being 
subscripted so that | X i | > | > ^ + 1 | . 

Thus, in general, the eigenvalues appear on the 
main diagonal, starting from the last position, in 
increasing order of moduli. 

So, when the smallest eigenvalue X^ has been 
found, we can reduce the order of the matrix by 
neglecting the last row and column and find \_i 
by the same process, without any special deflation. 

Note that the speed of convergence is consider- 
ably improved when the origin of the eigenvalues is 
shifted close to Xn- 



Such a shift — say, s— can be introduced 
before an iteration and the opposite one afterwards. 
Then the iteration can be written as: 



a(p> - s^p>i = q(p>r(p> 



a(p-^i) = i,(p)q(p),3(p)i 

In general, A^!^ , for p large enough, can pro- 
vide an efficient value for s^P'. 

3. Use of the Hessenberg form 

The Hessenberg form is preserved under the QR 
iteration. Thus, a reduction of the initial matrix 
to the Hessenberg form can give a significant 
saving of computation in each iteration for the QR 
decomposition, the lower part of the matrix con- 
sisting only of the codiagonal terms. 

Before each iteration, the codiagonal terms will 
be inspected. If some of these are zero, the matrix 
will be split according to this occurrence, and the 
iteration will be applied to the lower main subma- 
trix only. 

4. The double QR iteration 

Let A be a diagonalizable real upper Hessenberg 
matrix. Such a matrix must be expected to have 
complex conjugate pairs of eigenvalues. If these 
pairs are the only eigenvalues of equal modulus, it 
can be shown that they will appear as the latent roots 
of main submatrices of order 2. In this case, if a 
shift is close to one of these roots, it will be com- 
plex, and we will have to deal with complex ma- 
trices, although the initial one is real. The use of 
the double QR iteration avoids this inconvenience. 
Taking s(P''"l) = s^P), consider the transforma- 
tion giving a(P*^) from A^P): 

a(P+2)^q(P+1)*q(P)*a(P)q(P)q(P-M) 

It can be proved that the product Q^P'q^P de- 
rives from the QR decomposition of the matrix M = 
(A(P) - s(P) I) (A(P) - s(P"^l)l), which is real. 

In fact, Francis (1961, 1962) showed that only 
the first column m^^ of M is necessary for determin- 
ing the transformation which gives a'P''"^) from 
A^P), if they both have the Hessenberg form. 

Practically, the first part of the double iteration 
consists of the application of an initial transforma- 
tion NJ A^P) N;^ where Nj is unitary and such that 
Nf m^ = ± II m]^ 11 ei- This leads to a matrix that 
no longer has the Hessenberg form. 
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Thus, the remaining part of the iteration will 
involve the application of (n-1) successive trans- 
formations, which have the same form as the initial 
one whose matrices Nj are such that the resulting 
matrix a(P^2) jj^g ^^^ Hessenberg form. 

This process can fail when a subdiagonal term of 
the given matrix is zero. In this case, the matrix 
can be split, and the iteration is performed on the 
lower main submatrix only. 

In the subroutine, Nj are Householder's matrices. 

Programming Considerations: 

At each iteration, the latent roots x-^ and X2 of the 
lower main submatrix of order 2 are computed. 
Then the following situations can occur: 

1. The term an-i,n-2 can be taken as zero. Then 
x-j^ and X2 are eigenvalues of the original matrix, 
and the order of the matrix is reduced by 2. ANA(N) 
and ANA(N-l) are set to and 1 respectively. 

2. The term an^n-l ^^^ be taken as zero. In 
this case, a^^n is an eigenvalue of the original 
matrix, and the order of the matrix is reduced by 
1. ANA(N) is set to 1. 

3. One of the last two subdiagonal terms is stable 
through one iteration. Then the smaller one is con- 
sidered as zero. The corresponding components of 
ANA are set to or 1, according to situation 1 or 2. 

4. The maximum number of iterations is reached. 
In this case the smaller of the last two subdiagonal 
elements is taken as zero. The corresponding 
components of ANA are set to or 1, according to 
situation 1 or 2. 

The user can check the results by inspecting the 
subdiagonal terms of the matrix on return from the 
subroutine, according to the vector ANA, in the 
following way: If, for each ANA(I) containing 1, 

|A(I,I-l)|si0"%|RR(I)| + |RI(I)| ), 
i = 2 M 

then RR(I) and RI(I) were computed with a satisfac- 
tory accuracy. 



• Subroutine MEST 



•-EST.. 








MEST 10 


/**iii««*^iiii»««« 


*»*'** 




****«**«***«**«**«******»**«*****/HEST 20 1 


/* 








*/MESr 30 


/* EIGENVALUES OF A SYMMETRIC 


TRIOIAGONAL MATRIX 


♦/MEST 40 


/* 








•/MEST 50 


/****#*♦**«* 


ft**** 


****«*********»«*««« 


*«****«*******M***^c«***********/H£ST 60 1 


PROCEOURF 


(A,B 


.M.D.NEIG).. 




MEST 70 


OeCLAPE 








MEST eo 


(MIT 


,M,N, 


NEIG,Nfi,I,K,IT,J,IP) 


BINARY FIXED. 


MEST 90 


(CI, 


C2,C0(N»,COJrf(*),E7,EIC, 


G.H,P,PD,S,SH,T.U.A(*I ,B(*)) 


MEST 100 


BINARY,. 






MEST no 


£10 =l.CE-2C, 




/* CONSTANTS 


*/MEST 120 


E7 =l.CE-7,. 






MEST 130 


MIT =30, 








MEST 140 


H =0.5 


, . 






MEST 150 


N =M,. 






/* INITIALIZATION 


*/MEST 160 


IF NEiG GE N 






MEST 170 


THEN OOt . 








MEST 180 


NEin 


= N,. 






MEST 190 


NR 


=N-1 






MEST 200 


END, 








MEST 210 


ELSE NR 


*=NF!G,. 




MEST 220 


pm=c,. 








MEST 230 


DO I 


= 1 TO 


Nt. 




MEST 240 


D(I) 


=A( n 






MEST 250 


CD(i)=B(i )*e( n,. 




MEST 26C 


END, 








MEST 270 


DO K 


= 1 TO 


Nfi,. 


/* LOOP FOR NR EIGENVALUES 


VMEST 280 


Nl 


=N-1 






MEST 290 


PD 


=C,. 






MEST 300 




00 IT=I TO MIT,. 


/* START LOOP FOR ITERATION 


*/HEST 310 




CI 


=AaS(D(NJl .. 




MEST 320 




C2 


=CI*C1.. 


/* TEST CONVERGENCE 


•/MEST 330 




IF CO(NI LE E10*C2 THEN 


GO TO DEC,. 


MEST 340 




S 


=fl6S(D(N)-P0),. 




MEST 350 




IF S 


LE E7*Cl THEN GO TO 


DEC. 


MEST 360 




IF S 


GT H*C1 


/• TEST FOR APPLYING A SHIFT 


•/MEST 370 




THEN 


SH =0,. 




MEST 380 




ELSE 


SH =D(N),. 




MEST 390 




PO 


=D1N),. 




MEST 400 






DO J=N1 TO 2 BY -1, 


./*TEST FOR SPLITTING THE HATRIX*/MEST 410 | 






IF CD(J» LE E10*C2 


THEN GO TO SIT,. 


MEST 420 






END,. 




MEST 430 




J 


= 1,. 




WEST 44C 


SIT.. 








MEST 450 




s,u 


= C,. 


/•INITIALIZE THE TRANSFORMATION*/MEST 460 | 




C2 


= 1,. 




MEST 470 




G 


=0(J)-SH.. 




MEST 480 




P 


=G«G,. 




MEST 490 




CDJ 


=CO(JI,. 




MEST 50C 






00 I=J TO Nl,. 


/* QR TRANSFORHATION 


*/MEST 510 






IP =1*1.. 




MEST 520 






T "PtCOilP).. 




MEST 530 






CO(H = S*T,. 




MEST 540 






S =CD1IPJ/T,. 




MEST 550 






CI =C2,. 




MEST 56Q 






C2 =P/T,. 




MEST 57C 






0(!P»=0(IP)-SH,. 




M^ST 580 






U =S*IG+0{IPn,. 




MEST 590 






Dd) =G+U+SH,. 




MEST 600 






G =DaP)-Ut. 




MEST 610 






IF C2=0 




MEST 620 






THEN P =C0<IP)*C1,. 


VEST 630 






ELSE P =G«G/C2,. 




MEST 640 






END,. 




MEST 650 




CD(J»=COJ,. 




MEST 66C 




CD(N>=S*P,, 




"EST 670 




DIN) 


=G+SH,. 




MEST 680 




END, 




/* END LOOP FOR ITERATION 


♦/"EST 69C 


DEC. 








MEST 700 


N 


=N1, 




/* DEFLATE ORDER OF THE MATRIX 


*/MEST 710 


END, 








MEST 720 


IF NEIG LT M 






M^ST 73C 


THEN DO,. 








MEST 7^,0 


J=M- 


"JEIG, 






MEST 75C 




00 I 


I TO NEIG,. 




MEST 760 




J=J+ 


.. 




MEST 77C 




D(I) 


D( J>,. 




MEST 780 




END, 






MEST 790 


END, 








MEST 800 


RETURN,. 








MEST pio 


END,. 






/* END OF PROCEDURE MEST 


*/MEST 820 



Purpose: 

MEST computes the eigenvalues of a real symmetric 
tridiagonal matrix (see subroutine MSTU). 

Usage: 

CALL MEST (A, B, M, D, NEIG); 

A(M) - BINARY FLOAT 

Given vector containing the diagonal terms 

of the matrix. 
B(M) - BINARY FLOAT 

Given vector containing in positions 2, 

3 M, the codiagonal terms of the 

matrix. 
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M - BINARY FIXED 

Given order of the matrix. 
D(M) - BINARY FLOAT 

Resultant vector containing the eigenvalues. 
NEIG - BINARY FIXED 

Given number of eigenvalues required 

(see "Remarks"). 

Remarks: 

When the eigenvalues are well separated, this pro- 
cedure generally gives the NEIG eigenvalues of 
smallest moduli in the first NEIG positions of 
vector D. 

Vectors A and B are preserved. 

Method: 

QR iteration modified by Kaiser and Ortega. 

For reference see: 

J. M. Ortega and H. F. Kaiser, "The Ll'^ and QR 
methods for symmetric tridiagonal matrices", 
Computer Journal, Volume 6, 1963, pp. 99-101. 
J. H. Wilkinson, The Algebraic Eigenvalue Problem , 
Clarendon Press, Oxford, 1965. 

Mathematical Background: 

The general properties of the QR algorithm are 
given in the description of subroutine MEAT 
("Mathematical Background", items 1 and 2). We 
recall them briefly here. 

For a given diagonalizable matrix A of order n, 
the QR iteration is defined by: 



.(0) 



a,a(p)=q(p)r<p>,a(p"1> 



r(p) q(p) 



where Q(P) r(P) is a unitary-triangular factorization 
of a(P). a condition on R^P' is assumed to ensure 
the uniqueness of the factorization. If the eigen- 
values have distinct moduli, for example, | X^ | > 



X,- 



i+li 



for 1 = 1, 



n-1, then we have the 



following properties: 

1. When p tends to infinity, a^P' tends to a tri- 
angular matrix and the eigenvalues of A appear on 
the main diagonal of a(P) , starting from the last 
position in increasing order of moduli. 

2. The symmetry and the tridiagonal structure 
of a matrix are preserved under the QR iteration. 

3. If the origin of the eigenvalues is shifted close 
to X„ before an iteration and shifted back afterwards, 
then the rate of convergence of a^'^ to X^^ — that is, 
the rate of convergence of a^\ to zero for i = 1 , 

. . . , n-1, can be considerably improved. 



From the second property we can see that a 
preliminary reduction of a symmetric matrix to a 
similar tridiagonal form will give a significant 
saving of computation for each QR iteration. 

From the first property we note that no speciiii 
deflation is needed when >^ has been found to suf- 
ficient accuracy; the last row and column of the 
matrix are neglected and the iteration is applied 
to the reduced matrix to obtain \^_i- 

Let us consider a step of the iteration, denoted 
by 

A = QR , A' = RQ 

where A' is the iterate of A, the iteration super- 
script being dropped for clarity of notation. A and 
A' are symmetric tridiagonal matrices of order n. 
A will be fully defined by its diagonal terms 

aj , 1 = 1 n and its subdiagonal terms 

bi , i = 2, . . . , n. The terms of A' will be denoted 

by aj , i = 1 . . . , n and bj , i = 2 n. 

The reduction of A to R can be completed by pre- 
multiplication by (n-1) orthogonal matrices (Plane 
Rotations) Q. , 1 = 1 n-1 of the form 



Q. 



c. s. 
1 1 



-s. c. 
1 1 



i = 1 ,. . . , n - 1 



c. and s. are the cosine and sine of an angle such 
that 



Then: 



R = Q^_^...Q^A 



Q = Q* . . Q* 

1 n-1 



c. and s are given by 
^ i 



'' ^i^^.r 
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^=-2 



i+1 



(Pi " ^ . i) 



1/2 



g. = a. - u. 
1 1 1-1 



2 2/2 
p, = g. / c. , when c. ,?^0 
1 1 / 1-1 1-1 



with 



and 



i = 1, . . . ,n - 1 



p. = c a - s , c. „ b. . , 
i i-1 i i-1 1-2 1+1 



(1) 



2 u2 

=c. „ b. 

1-2 1 



when c. , = 
1-1 



b-'Ss^, (pSb^^J fori>l 
1 1-1 1 1+1 



(4) 



R will be defined by: 



r. .=c. p. + s. b.^, , i= 1 , . 
1,1 1 1 1 1+1 



r = p 
n,n ^n 



r, «= c,b„ + s, a„ 
1,2 1 2 12 



,n-l 



(2) 



2 u2 / 2 ^ . 2 
^ =^+lAi ^^+l) 



2 2/2 ^2 , 

c.= P. /p. +b.^J 

11/ 1 1+1 



u. = s. (g. + a ) 
1 1 1 1+1 



a. = g. + u. 
Ill 



i = 1,2, . . . , n 



r. . H = c. c b. , + s. a. , , 
i, i+1 i i-1 1+1 i 1+1 



Programming Considerations: 



i = 2,. . . , n-1 



r. . „ = s. b. „, i = 1, . . . , n - 2 
i, i+2 i i+2 



r. . = for j > i+2 
1.3 



The post-multiplication of R by Q will provide A , 
according to: 



^= ^ ^1,1 ^^1^,2 



a. = c. , c. r. . + s. r. . , 
1 1-1 1 1,1 1 1,1+1 



i= 2 n-1 



a - c r 
n n-1 n,n 



b. , = s. r. , . , 
i+1 1 i+1, 1+1 



(3) 



i = 1 n-1 



Formulas (2) and (3) can be combined in order to 
get A directly from A. This avoids the computa- 
tion of the square roots appearing in the expres- 
sions of c^ and Sj . 

Then the final algorithm can be expressed as 
follows: 



"0 = °'% = !' Vi = «' Vi = ° 



The iteration is performed according to equations 
(4). A shift of the origin of the eigenvalues is intro- 
duced in order to accelerate convergence. This 
shift is based on the last diagonal term of the matrix; 
it is applied only when convergence begins appearing. 
When several eigenvalues are of same magnitude, 
codiagonal terms are close to zero. Then the matrix 
is split according to this occurrence and the itera- 
tion is performed on the lower main submatrix only. 
The iteration is stopped and the last diagonal term 
is taken as an eigenvalue when one of the following 
situations occurs: 

1 . The last subdiagonal term can be taken as 
zero. 

2. The last subdiagonal term is stable through 
one iteration. 

3. The maximum number of iterations is reached. 
Then the order of the matrix is reduced by one and 
the process is repeated on the resulting matrix. 
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Subroutine MEBS 



NEBS.. 

/ ***************** 

/* 



**********************^^^^^tt^t*** 



MEBS 
*************$ft/ti{ESS 

/♦ BOUNDS FOR THE EIGENVALUES OF A SYMMETRIC MATRIX l/nlll 

/*********************t*******;^»t*^^^*^^^^^^^^^^^^^^_^^^ */ME8S 

PROCEDURE CA,N,B1,B2I,. 
DECLARE 

CIfJ»Ka*NI BINARY FIXED, 
(A(*KBUB2*P,SQ) BINARY, 
<S.S1,S2) BINARYI53>,. 



**********************t***0***^^^^t*/MEQS 

MEBS 70 
MEBS 80 
MEBS 90 
MEBS 100 
MEBS 110 
MEBS 120 
MEBS 130 
MEBS 140 
MEBS 150 
MEBS 160 
MEBS 170 
MEBS 180 
♦/MEBS 190 
MEBS 200 
MEBS 210 
HE8S 220 
MEBS 230 
MEBS 240 

SQRTnN-l»*ABSlN*« <:.*^.., i! ^"" *"' ^"^ SQUARES OF ROOTS */mIII 260 
(1-N)is2lsilsi ITERATE FROM INFINITY «/HEBS 270 

** MEBS 280 

MEeS 290 



=A(1),. 
=0,. 

=S1*S1,. 
= 1.. 

DO K=2 TO N, . 
I =I+K,. 

SI =S1+A(I1,. /» 

S=S+MULTIPLY(AII>,A(I»,53),. 
00 L=J TO I-l,. 

S2=S2+MULTIPLY(AIL),AIL),53),. 

END,. 
J =1*1,. 
END*. 
=2*S2+S,. 



SUM OF THE ROOTS 



IF SI LT 





THEN 


00, 






Bl 


=S1-SQ, . 




B2 


=P/B1,- 




Bl 


==ei/N,. 




ENn, 


, 


ELSE 


DO,. 






82 


=S1+SQ,. 




bl 


-P/82,. 




B2 


=62/N,. 




END, 


. 


RETURN,. 




END, 




y 



END OF PROCEDURE MEBS 



MEBS 


100 


MEBS 


310 


MEBS 


3?n 


MEBS 


330 


MEBS 


340 


MEBS 


350 


MEBS 


^(>o 


MEBS 


370 


MEBS 


380 


MEBS 


390 


MEBS 


400 


♦/MEBS 


410 



Purpose: 

MEBS computes a lower and an upper bound for the 
eigenvalues of a real symmetric matrix. 

Usage: 

CALL MEBS (A, N, Bl, B2); 

A (N*(N+1) /2) - BINARY FLOAT 

Given real symmetric matrix in 

compressed storage mode. 
N - BINARY FIXED 

Given order of the matrix. 
Bl - BINARY FLOAT 

Resultant lower bound. 
B2 - BINARY FLOAT 

Resultant upper bound. 

Method: 

Laguerre's iteration is applied to the points at 
infinity. 

For reference see: 

B. Parlett, "Laguerre's Method Applied to the 
Matrix Eigenvalue Problem", Mathematics of Com- 
putation, 18, 1964. 

Mathematical Background: 



Laguerre iterate of a point x for the poly- 
nomial P can be expressed by 



Lp(x) = X 



n P (X) 



P (X) ±Y(n-l) [(n-1) P' (x)^ - n P (X) P" (x)] 

(1) 
Letting 



1=1 1 



s M - P (X) - P(x) P"(x) 
P(x) 



n 

E 



i=l (x-x.) 

where x^ x^^ are the roots of P(x), formula 

(1) can be written as 



Lp{x) = X 



^1* 



^J^- 



1) (nS, 



^ 



(2) 



The sign of the square root is chosen so that the 

magnitude of the denominator is maximum. 

When P(x) has real roots, we have the following 

properties: 

a. Let us consider a partition of the real 
line defined by the points at infinity and 
the zeros of P^ (x). Starting from an 
initial point in any interval of the parti- 
tion, the successive Laguerre iterates 
converge monotonically to the root there- 
in. If the root is simple, convergence is 
asymptotically cubic. 

b. Laguerre's iterations are invariant under 
Mobius transformations. 
2. Iterates of the points at infinity. 

From the first property of monotonic con- 
vergence, we can see that the iterates of the 
points at infinity will provide bounds for the 
roots. The second property gives the rela- 
tion. 



1. Laguerre's iteration. 

Let P(x) be a polynomial of degree n. The 



Lp(x) 



Vr) 



(3) 
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where Q is the polynomial reciprocal of P, 
the roots of which are 



X. , i = 1, . . . , n. 
1 



• Subroutine MVST 



Thus 



S(-)=I^)- 



(4) 



Now, if we combine equations (2) and (4), we 
can obtain the final formula 



Lp (-) =^[o^ ± \M^(n a 2 - CT^)] 



(5) 



where a is the sum of the roots and a the 
sum of the squares of the roots of polynomial 
P. 

Programming Considerations: 

We can note that equation (5) does not require the co- 
efficients of polynomial P but only the values of g j^ 
and 02- If we apply this formula to the character- 
istic polynomial of a symmetric matrix (real roots), 
(j^ will be obtained by computing the trace of the 
matrix and ct^ the sum of the squares of the terms 
of the matrix. Then, equation (5) will give the 
bounds of the eigenvalues. 





MVST,. 


MVST 10 


/«****«#*#******»*«**«****»**«»**«**»*»*******************************/MVST 2 1 


/• 


*/MVST 30 


/♦ EIGENVECTORS OF A SYMMETRIC TRIDIAGONAL MATRIX 


•/MVST «0 


/* 


*/MVST 50 


/«*«*••«»•***•••***•***»* t!*********#**»****#**********»***************/MVST 60 1 


PROCEDURE (DtCO.N.EIG.Y),. 


MVST 70 


DECLARE 


MVST 80 


)D(«t,CD{*),EIG.Y{*),E7,T,EPS,M, 


MVST 90 


X(N1,P(N),Q(N),A(NJ,R(N),U,V,S,CI.CIP) BINARY, 


MVST 100 


1N,1.IPI,NI,IT,U) BINARY FIXED. 


MVST 110 


CHINl 8IT(L].. 


MVST 120 


Nl=N— I » . 


MVST 130 


E7=l.0E-7t . 


MVST 140 


T=ABS(Otin.. /• NORM OF THE MATRIX 


*/MVST 150 


00 1=2 TO N,, 


MVST 160 


M=MAX(ABS(D(UI fABSICDdt) ).. 


MVST 170 


IF W GT T THEN T=W, . 


MVST 180 


END,. 


MVST 190 


EPS=T»E7,. 


MVST 200 


U=D{1)-EIG,. 


MVST 210 


IF ABS(C012»» LT EPS 


MVST 220 


THEN V,C1P=EPS,. 


MVST 230 


ELSE V,CIP=C0(2),. 


MVST 2*0 


00 1 = 1 TO Nl,. /* START FACTORUATION 


♦/MVST 250 


IPl=I+l» . 


MVST 260 


CI*C1P, . 


MVST 270 


IF I = Nl 


MVST 280 


THEN C1P=0,. 


MVST 290 


ELSE If ABSICDUPltlll LT EPS 


MVST 300 


THEN CIP=EPS,. 


MVST 310 


ELSE CIP^CDIIPUI),. 


MVST 320 


IF ABS(Cn GE ABS(U» /* PIVOTING 


•/MVST 330 


THEN DO,. /* INTERCHANGE 


•/MVST 340 


IF U NE 


MVST 350 


THEN AaPl) = U/CI,. 


MVST 360 


ELSE IF CI=EPS 


MVST 370 


THEN A(IPl)=X,. 


MVST 360 


ELSE A(1P11=0,. 


MVST 390 


P(I)=CI,. 


MVST 400 


QlIl=i)IIPll-ElG,. 


MVST 410 


R(I)=CIP,. 


MVST 420 


U=V-A{IPll*QtI),. 


MVST 430 


V= -AUPI)*R(I ).. 


MVST 440 


CH(IP1)='1'B,. 


MVST 450 


END.. 


MVST 460 


ELSE DO,. /» NO INTERCHANGE 


*/MVST 4T0 


A1IP1)=CI/U.. 


MVST 480 


P(I1=U.. 


MVST 490 


OII>=V,. 


MVST 500 


R(11=0,. 


MVST 510 


U=D(IP1»-EIG-V«A(IP1>,. 


MVST 520 


V=CIP,. 


MVST 530 


CHIIP1)='0'B,. 


MVST 540 


END,. 


MVST 550 


IF ABS(P(n) LT EPS THEN P(I)=EPS,. 


MVST 560 


XII)=U. /* INITIAL GUESS OF £IGENVECTOR*/MV$T 570 | 


END,. 


MVST 580 


IF ABS(U) LT EPS THEN U=EPS,. 


MVST 590 


P(NI=U,. /* END FACTORIZATION 


•/MVST 600 


X(N)=1,. 


MVST 610 


00 IT=l,2.. /* START LOOP FOR ITERATION 


•/MVST 620 


IF IT GT I 


MVST 630 


THEN DO,. /• SOLVE WITH LOWER FACTOR 


•/MVST 640 


V=ABS(X(1)).. 


MVST 650 


DO 1=2 TO N,. /* NORMALIZATION 


•/MVST 660 


U=ABS(X(I)).. 


MVST 670 


IF U GT V THEN V=U,. 


MVST 680 


END.. 


MVST 690 


XIII=X(l)/V,. 


MVST 700 


DO 1=2 TO N,. 


MVST 710 


X(I)=XII)/V,. 


MVST 720 


IF CH(U 


MVST 730 


THEN DO,. 


MVST 740 


11=1-1,. 


MVST 750 


U=XII1),. 


MVST 760 


x(ii)=xm,. 


MVST 770 


xu)=u-A(i)*xni),. 


MVST 780 


END.. 


MVST 790 


ELSE X(I)=X(n-Am*X(I-l),. 


MVST 800 


END,. 


MVST 810 


END,. 


MVST 820 


X(N>=X(N)/P(N),. /* SOLVE WITH UPPER FACTOR 


•/MVST 830 


X(N1I=(X(N1)-QIN1)*X(N))/P1N1),. 


MVST 840 


DO I=N-2 TO I BY -1,. 


MVST 850 


x(n = ixin-Qm*x(i+i)-R(n*xii*2)i/p(i),. 


MVST 860 


END,. 


MVST 870 


END,. /* END LOOP OF ITERATION 


*/MVST 880 


S=0,. 


MVST 690 


DO 1=1 TO N,. /• NORMALIZE SOLUTION 


•/MVST 900 


s=s+x(n*xii),. 


MVST 910 


END,. 


MVST 920 


S=SQRT(S),. 


. MVST 930 


00 1=1 TO N,. 


MVST 940 


Y(I)=X(I)/S,. 


MVST 950 


END,. 


MVST 960 


RETURN,. 


MVST 970 


END,. /* END DF PROCEDURE MVST 


♦/MVST 980 



Purpose: 

For a given sjmimetric tridiagonal matrix, MVST 
provides the eigenvector corresponding to a given 
eigenvalue. 

Usage: 

CALL MVST (D, CD, N, EIG, Y) ; 
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D(N) - BINARY FLOAT 

Given vector containing the diagonal terms 

of the matrix. 
CD(N) - BINARY FLOAT 

Given vector containing in positions 2, 3, 

. . . , N the codiagonal terms of the matrix. 
N - BINARY FIXED 

Given order of the matrix. 
EIG - BINARY FLOAT 

Given eigenvalue. 
Y(N) - BINARY FLOAT 

Resultant vector containing the eigenvector. 

Remarks: 

Vectors D and CD remain unaltered. 

Method: 

Wielandt's inverse iteration is applied to the matrix, 
using the given eigenvalue as a shift. 

For reference see: 

J. H. Willcinson, The Algebraic Eigenvalue Problem 
Clarendon Press, Oxford, 1965. 

J. H. Wlllcinson, "Calculation of the eigenvectors of 
the symmetric tridiagonal matrix by inverse itera- 
tion", Numerische Mathematilt, 4 (1962), pp. 368-376. 

Mathematical Backgroxmd: 

Let us suppose that we know an approximation X of an 
eigenvalue of a symmetric tridiagonal matrix A. A 
corresponding eigenvector V can be obtained by using 
Wielandt's inverse iteration (see the description of 
procedure MVAT), defined by the iterative process: 

V<P^^) = (A - A I)-l V<P> 

(0) 
where V is an arbitrary vector, not deficient in the 
eigenvector V. 

Considering a triangular factorization of A-AI, 

A - A I = LR, 

V will be provided by solving successively the 

following equations: 



quite sufficient to provide an accurate approximation 
of V. 

Programming Considerations: 

A technique of partial pivoting by row interchange is 
used for the triangular factorization. This factoriza- 
tion is performed before starting the iterative process. 

The two iterations are then carried out according 
to formulas (1) and (2), 

The initial vector V^^) is chosen so that 



V(0) = Le, with eT = (i, i,' __ ^^ 

iteration will consist of solving equation72ro^y 



1). Then the first 



RV 



.(1) 



LW = V<P) 
RV(P^^> = W 



(1) 
(2) 



M 



When A is close to an eigenvalue of A, V^' tends very 
rapidly to V. Most of the time, two iterations are 
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• Subroutine MSDU 



DU.. VSDU 10 

******************************** >K4'«*«iK**«**«***********«»«««»««««««*/»rf SOU 20 

*/MSOU 30 

TO COHPUTE EIGENVALUES AND EIGENVECTORS OF A REAL SYMMETRIC */MSOU 40 

MATRIX */MSDU 50 

*/MSOU 60 

PROCEDURE (A.R.N.MV),. MSOU 8C 

DECLARE HSDU 90 

(I.IND,J,L,M,MV,N) MSOU IOC 

FIXED BINARY, MSOU 110 

ERROR eXTEPNAL CHARACTER! 1 } , fSDU 120 

1A(*,*),R(*,*) .ANORM, ANRMX,THR,U,Y,SlNX,$INX2,CDSX,COSX2tSINCS,MSOU 130 



FNI 

BINA.*Y FLOAT,. 
* BINARY FLOAT (53),. 

ERROR='0',. 
If N LE 1 
THEN DO, . 

ERRPR = ' !• ,. 

GO TO FIN,. 

END, . 



FN 



=N, 



IF MV= C 
THEN 00, 



00 I = 1 TO N,. 

DO J = I T 
R( I ,J)^0,. 

END,. 
P(I,I)=l,. 
END,. 



COMPUTE INITIAL AND FINAL NORM 

ANORH=0, . 

00 I = 1 TO N-1,. 

00 J = 1*1 TO N,. 

ANORM=ANORMtA( I,JI*A( I,J> , 

END,, 
END, . 
IF ANCRM LE CO 
THEN GO TO SORT, . 
AN0RM=1.'.14*SQRT( ANORM) ,, 
ANRMX=ANGRM«1 . 0E-6/FN, . 



THE ORDER OF MATRIX ^ IS 
LESS THAN OR EQUAL TO ONE. 



GENERATE IDENTITY MATRIX 



= 1, 



/* COHPUTE SIN AND COS 



INITIALIZE INDICATOR AND COMPUTE THRESHOLD, THR 



SIO.. 

THR 
S20.. 

L 
S30.. 

M =L+1,. 
S40.. 

IF ABS(A(L,M)( GE THR 
THEN DO,. 

INO =1,. 

U =0.5*(A(L,L)-A(M,M) I,. 

Y =-A(L,M)/SORT(A(L,M)*A(L,M)*U*U),. 

IF U LT 0.0 

THEN Y =-Y,. 

SINX =Y/S0RTI2.C*U.C+(SORTU.0-y*Y) ))), 

SiNX2=SINX*SINX, . 

CQSX =SORT( 1.C-SINX2) ,. 

C0SX2=C0SX*C0SX,. 

SINCS=SiNX«COSX,. 

00 I = I TO N, . 
IF I LT L 
THEN 00,. 

IF I LT M 
THEN DO,. 

U =A( 1 ,L)*CCi'^X-AI I ,H)*SINX,. 
A( 1 ,M)=A( I,L)*SINX*A(I,M)*COSX, . 
AII,L)=U, 









END,. 








END,. 








ELSE IF 1 GI L 








THEN DO,. 








IF I LT M 








THEN DO,. 








U =A(L,I)«COSX-A(I,H)*SINX,. 








A(I,M)=A(L,I)*SINXtA(l,MI*COSX,. 








END,. 








ELSE IF I GT M 








THEN DO,. 








U =AlL,I)*COSX-A(M,I)*SINX,. 








A(M,I)=A(L,n*SINX*A(M,I)*COSX,. 








END,. 








IF I NE M 








THEN AIL,I)=U,. 








END,. 








IF MV= 








THEN DO,. 








U =R(I ,L)«COSX-M I,M)*SINX,. 








R(I.M) = R(I,L)*SINX«-Rn,M)*COSX,. 








R(I,L)=U,. 








END,. 








END,. 






U 


=2.C*A(L,M)*SINCS,. 






Y 


=A(L,L)*CCSX2*A(M,M)*SINX2-U,. 






U 


=A(l.,L)*SINX2+A!M,M)*CnSX2*U,. 






AIL, 


M)=1A{L,LI-A(M,M1)*SINCS*A(L,M)*(C0SX2-SINX2).. 






AIL. 


L)=Y,. 






AIM, 


M)=U, . 






END, 






IF H 


NE U 


/* TEST FOR H = LAST COHrMN 




THEN 


DO,. 








M 


=Mtl,. 






GO TO S40,. 






END, 




/* 








/* 




TEST 


FOR L = SECOND FROM LAST COLUMN 


/* 










IF L 


NE N 


-1 




THEN 


DO, . 








L 


=L*1,. 



MSDU 140 

/♦SINGLE PRECISION VERSION /*S*/M$DU 150 
/•DOUBLE PRECISION VERSION /*0*/MSDU 160 
*/MS0U ITC 
MSDU 180 
*/MSDU 190 
•/MSDU 200 
MSOU 21^^ 
MSnu 220 
MSOU 230 
MSOU 240 
MSOU 250 
MSDU 260 
•/MSDU 270 
MSDU 280 
MSOU 290 
MSOU 300 
MSDU 310 
MSOU 320 
MSDU. 330 
•/MSDU 340 
*/MSOU 350 
•/MSDU 360 
MSOU 370 
HSDU 380 
MSDU 390 
MSDU 400 
MSDU 410 
MSOU 420 
MSOU 43C 
MSOU 440 
MSDU 450 
MSOU 460 
•/MSOU 470 
*/MSDU 480 
•/MSOU 490 
MSOU 500 
MSDU 510 
MSOU 520 
MSDU 530 
MSDU 540 
MSDU 550 
MSDU 560 
MSDU 570 
MSOU 580 
•/MSDU 590 
MSDU 600 
MSDU 610 
MSDU 620 
MSOU 630 
MSDU 640 
MSOU 650 
MSDU 660 
MSOU 670 
MSOU 680 
MSDU 690 
MSDU 700 
•/MSOU 710 
MSDU 720 
MSDU 730 
MSOU 740 
MSDU 750 
MSOU 760 
MSDU 770 
MSDU 78C 
MSDU 790 
MSDU 8-^0 
MSDU 810 
MSDU 820 
MSOU 830 
MSDU 840 
MSOU 850 
MSDU 860 
MSOU 870 
MSDU 880 
MSOU 890 
MSDU 900 
MSOU 910 
MSOU 920 
MSDU 930 
MSOU 940 
MSOU 950 
MSDU 960 
MSDU 970 
MSDU 980 
MSDU 990 
MSOUICOO 
MSDUIOIO 
MSDU1020 
MSDU103C 
MSDU1040 
MSDU1050 
HSDU1060 
MSDU 1070 
MS0U1080 
MSOU 1090 
•/MSOUllOO 
MSDUlllO 
MSDU1120 
MSDU1130 
MS0U1140 
•/MSDU1150 
♦/MSDU1160 
•/MSDU1170 
MSDU1180 
MSDU1190 
MS0U1200, 



■ ROTATE L AND H COLUMNS 





GO TO S30,. 


MSDU1210 




END,. 


MSDU1220 


IF IND= 1 


MSDU1230 


THEN 


on,. 


MSDU1240 




IND =0,. 


HS0U1250 




GO TO S20,. 


MSOU1260 




ENO,. 


MSDU1270 


/* 




•/MS0U1280 


/* 


COMPARE THRESHOLD WITH FINAL NORM 


♦ /MSOUU90 


/* 




♦/MS0U1300 


IF THR GT ANFMX 


HSDU1310 


THEN 


GO TO SIO,. 


MS0U1320 


/* 




•/MSDU1330 


/* 


SORT EIGENVALUES AND EIGENVECTOPS 


•/MSDU1340 


/* 




•/MSDU1350 


SORT., 




MSDU 1360 




DO I = 1 TO N,. 


MSDU1370 




00 J = I TO N,. 


M$DU1380 




IF A<I,I> LT AU,J) 


MS0U1390 




THEN DO,. 


MSDU1400 




U =A(I,I).. 


MS0U1410 




AII,I)=AU.J),. 


MS0U1420 




A( J,J)=U,. 


MSDU1430 




IF MV= 


MSDU1440 




THEN DO,. 


MS0U1450 




DO L = 1 TO N,. 


MSDU 1 460 




U =RIL,I),. 


MSOU1470 




R(L,I) = Ra,J),. 


MSDU1480 




R(L.J1=U,. 


MSOU 1490 




END,. 


HS0U1500 




END,. 


HS0U1510 




END,. 


MSDU1520 




END,. 


MSDU1530 




END,. 


MS0U1540 


FIN.. 




MSOU 1550 


RETURN,. 


MS0U1560 


END, 


/♦END OF PROCEDURE MSOU 


•/MSDU1570 



Purpose: 

MSDU computes eigenvalues and eigenvectors of a 
real symmetric matrix. 

Usage: 

CALL MSDU (A, R, N, MV); 



A(N,N) 



R(N,N) 

N - 
MV- 



BINARY FLOAT [(53)] 

Given matrix (symmetric), destroyed in 

computation. 

Resultant eigenvalues are developed in the 

diagonal of matrix A in descending order. 

BINARY FLOAT [(53)] 

Resultant matrix of eigenvectors (stored 

coliunnwise, in the same sequence as 

eigenvalues). 

BINARY FIXED 

Given order of matrix A and R. 

BINARY FIXED 

Given code containing the following: 
— compute eigenvalues and eigen- 
vectors. 
1 — compute eigenvalues only. 



Remarlcs: 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error condition 
that may be detected: 

ERROR=l - The order of the matrix is one or less. 

Note : If the initial norm is equal to zero, the matrix 
is diagonal. 
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Method: 

Diagonalization method originated by Jacobi and 
adapted by Von Neumann for larger computers as 
found in Mathematical Methods for Digital Computers, 
edited by A. Ralston and H. S. Wilf , John Wiley and 
Sons, New York, 1962, Chapter 7. 

Mathematical Background: 

This subroutine computes the eigenvalues and eigen- 
vectors of a real symmetric matrix. 

Given a symmetric matrix A of order N, eigen- 
values are to be developed in the diagonal elements 
of the matrix. A matrix of eigenvectors R is also 
to be generated. 

An identity matrix is used as a first approxima- 
tion of R. 

The initial off-diagonal norm is computed: 



"■ '- )?<. <\ ''' 



CO = Sign (M) 



V = initial norm 



A = input matrix (sjnnmetric) 

This norm is divided by N at each stage to produce 
the threshold. 

The final norm is computed: 



''f =" 



l/jX 10 



v7T7 



sin 6 



CO 



V2(l + Vl^) 



,.^ 



N 



(2) 



cos 9= wl - sin 6 



B = A., cos e -A. sin 6 
il im 



C = A., sin e + A. cos 6 
il im 



B = R._ cos 9 - R. sin 6 
il im 



R. = R., sin 9 +R. cos Q 
im il im 

R., = B 

il 



2 2 

A., = A., cos 9 + A sin 9 
il il mm 



- 2A, sin 9 cos 9 
Im 

2 2 

\ = A,- sin 9 + A cos £ 

mm 11 mm 

+ 2A, sin 9 cos 9 

A^ = (A,, - A ) sin 9 cos 9 
Im ^ 11 mm' 

2 2 

+ A^ (cos 9 - sin 9) 



(5) 

(6) 

(7) 

(8) 

(9) 

(10) 

(11) 
(12) 

(13) 
(14) 



(15) 



This final norm is set sufficiently small that the 
requirement for any off-diagonal element A^j^ to 
be smaller than v^ in absolute magnitude defines 
the convergence of the process. 

An indicator is initialized. This indicator is 
later used to determine whether any off-diagonal 
elements have been foimd that are greater than the 
present threshold. 

Each off-diagonal element is selected in turn and 
a transformation is performed to annihilate the off- 
diagonal (pivotal) element, as shown by the following 
equations: 



The above calculations are repeated xmtil all of the 
pivotal elements are less than the threshold. 

Programming Considerations: 

Matrix A cannot be in the same location as matrix 
R. If the eigenvectors are not calculated, the 
matrix R does not need to be dimensioned in the 
declare statement, but R must appear in the argument 
list of the procedxire. 



A. = -A. 
im 

H = 1/2 (A,, -A ) 
'^ Ml mm' 



(3) 
(4) 
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• Subroutine MGDU 



HGDU.. 






MGDU 10 


/****** 


•******«*«**««4i»«*«««>«»«***«**«««*«*********««»«»« 


**«****«**««*/MGOU 20 1 


/♦ 








•/MGOU 30 


/• 




TO COMPUTE EIGENVALUES AND EIGENVECTORS OF A REAL 


NONSYMH- •/MGDU 40 1 


/« 




ETRIC MATRIX OF THE FORM B INVERSE TIMES A. 




*/MGOU 50 


/* 








•/MGDU 60 


/»• 




****/MGDU 70 




PROCEDURE IM.A,B.XL,X},. 




MGDU 60 




DECLARE 




MGDU 90 






(IiJtH.MV.K) 




MGDU 100 






FIXED BINARY, 




MGDU 110 






ERROR EXTERNAL CHARACTER t 1 } , 




MGDU 120 






CA(«,»),B(*,*).X(*,*),XLI*),SUMV) 




MGOU 130 






BINARY FLOAT,. /*SINGLE PRECISION 


VERSION 


/*S*/MGDU 140 


/* 




BINARY FL0AT(53),. /*DOUBLE PRECISION 


VERSION 


/«0*/MGDU 150 


/♦ 








♦/MGDU 160 


/* 




COMPUTE EIGENVALUES AND EIGENVECTORS OF B 




»/MGDU 170 


/* 








*/HGOU 180 


/* 




THE MATRIX B IS A REAL SYMMETRIC MATRIX. 




*/MGOU 190 


/* 








*/MGDU 200 




MV 


=0,. 




MGOU 210 




CALL 


MSOU (B.X,M,HV},. 




MGDU 220 




IF ERROR NE '0' 




MGDU 230 




THEN 


GO TO FIN,. 




MGOU 240 


/* 








*/MGOU 250 


/* 




FORM RECIPROCALS OF SQUARE ROOT OF EIGENVALUES. THE RESULTS */MGDU 260 1 


/* 




ARE PREMULTIPLIED BY THE ASSOCIATED EIGENVECTORS 




*/MGDU 270 


/* 




00 I = 1 TO M,. 
XLII)=1.0/SQRTIA6S<B{I,I)>),. 
DO J = 1 TO M,. 

B)j,n=x{j,n«xL(ii,. 

END,. 
END,. 




*/MGDU 280 
MGOU 290 
MGOU 300 
MGDU 310 
MGDU 320 
MGDU 330 
MGOU 340 


1* 








♦/MGOU 350 


/* 




FORM IB**(-I/2))PRIHE * A * (B**(-l/21) 




«/MGDU 360 


/* 




CO I = I TC M,. 

DO J = 1 TO M,. 
X{I,J)=0.0,. 

DO K = 1 TO M,. 
X(I,J)=XII,J>'i'B(K,U*AIKtJl,. 
END.. 
END,. 
END,. 
DO I = 1 TO M,. 

DO J = 1 TO M,, 
A(I,J)=0.0,. 

00 K = 1 TO H,. 
AIItJ)=A(I,J)*xa,K)*B(K,J),. 
END,. 
END,. 
END.. 




♦/MGOU 370 
MGDU 360 
MGOU 390 
MGOU 400 
MGOU 410 
MGOU 420 
MGDU 430 
MGOU 440 
MGOU 450 
MGDU 460 
MGDU 470 
MGDU 480 
MGOU 490 
MGOU 500 
MGDU 510 
MGDU 520 
MGDU 530 


/• 








•/MGDU 540 


/* 




COMPUTE EIGENVALUES AND EIGENVECTORS OF A 




♦/MGDU 550 


/♦ 








♦/MGOU 560 




CALL 


MSOU IA,X,M,HV),. 

DO I = I TO M,. 

xLni=An,i).. 




MGOU 570 
MGDU 580 
MGOU 590 


/* 








♦/MGDU 600 


/* 




COMPUTE THE NORMAL! ZED EIGENVECTORS 




♦/MGOU 610 


/* 




00 J = 1 TO M,. 

A(I,J)=0.0,. 

DO K " I TO M,. 

AII,J)'A(I(J)V8(ItK)*X(K,JI,. 

END.. 

END,. 
END,. 

00 J = 1 TO M,. 
SUMV =0.0,. 

00 K = 1 TO M,. 

SUMV =i=SUMV4'A(K,J>*A(K,J),. 

END,. 
SUMV -SQRTfSUMV),. 

DO K = 1 TO M,. 

X(K,J)=AIK,J)/SUMV,. 

END,. 
END,. 




♦/MGOU 620 
MGOU 630 
MGOU 640 
MGOU 650 
MGDU 660 
MGOU 670 
MGDU 680 
MGOU 690 
MGDU 700 
MGOU 710 
MGDU 720 
MGOU 730 
MGDU 740 
MGDU 750 
MGOU 760 
MGDU 770 
MGDU 780 
MGDU 790 


FIW 








MGDU 800 




RETURN. . 




MGDU 810 




END, 


/*END OF PROCEDURE 


MGDU 


♦/MGOU 820 



XL(M) 



X(M,M) - 



Remarks: 



BINARY FLOAT [(53)] 

Resultant vector containing eigenvalues 

of B-inverse times A, 

BINARY FLOAT [(53) J 

Resultant matrix containing eigenvectors 

columnwise. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero by the 
called subroutine MSDU, The following constitutes 
the possible error condition that may be detected: 

ERR0R=1 MSDU has been called and an error 
has occurred (see MSDU). 

Subroutines and fimction subroutines required: 

MSDU 

Both matrices A and B are destroyed. 

Method: 

Refer to W. W. Cooley and P. R. Lohnes, 
Multivariate Procedures for the Behavioral 
Sciences , John Wiley and Sons, 1962, Chapter 3. 



Mathematical Background: 

This subroutine calculates the eigenvalues and the 
matrix of eigenvectors of the matrix B"-*- A. 

First the subroutine MSDU is used to calculate 
the eigenvalues and eigenvectors of the matrix B. 
The eigenvalues bjj are stored in the main diagonal 
of the original matrix B and the eigenvectors are 
stored columnwise in the matrix X. Next the square 
roots of the reciprocals of the eigenvalues bjj are 
formed and stored in XL 



Purpose: 

MGDU computes eigenvalues and eigenvectors of a 
real matrix of the form B-inverse times A, where 
A is symmetric and B is positive definite. 
Usage: 

CALL MGDU (M, A, B, XL, X); 

M - BINARY FIXED 

Given order of square matrices A, B, 

and X. 
A(M,M) - BINARY FLOAT [(53)] 

Given symmetric matrix. 
B(M, M) - BINARY FLOAT [(53)] 

Given positive definite matrix. 



XL. = 1/ 



V^ 



Then each eigenvector stored in X is multiplied by 
the corresponding value XLj, The matrix of 
results is again stored in B. Next the matrix 
B^AB is generated and stored in A. Then the sub- 
routine MSDU is used to calculate the eigenvalues 
and eigenvectors of B^AB. The eigenvalues are 
stored in XL and the eigenvectors are stored in X, 
Next the matrix product BX is formed and stored in 
A. The eigenvectors are then normalized to the 



form a../ V SUM.a./ 
matrix of eigenvectors. 



to form the desired output 
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• Subroutine MVAT 



HVAT . . 


MUAT in 


/*****************m***************mm**»****m*****mmm**9***m*m*****#***/ti{yii Jo ! 


/* 


♦/MVAT 30 


/* EIGENVECTORS OF A COMPLEX HESSEN6ERG MATRIX 


♦/MVAT 40 


/* 


*/MVAT SO 


/•***********m****** ******************************************** *i^**M*/Hyta 60 I 


PROCEDURE (A.NtEtG.V),. 


HVAT 70 


DECLARE 


HVAT ao 


DtNl 


MVAT 90 


BITII), 


MVAT 100 


lETtUtTfEPSl 


MVAT no 


8INARV, 


HVAT 120 


(AI*,»),EIG,C,V(*)). 


MVAT 130 


COMPLEX BINARY, 


MVAT 140 


S 


MVAT 150 


COMPLEX BINARY! 53), 


MVAT 160 


(N*IS(N),l,IUJ.Nl,K,KltKPl,IT) 


MVAT 170 


BINARY FIXED,. 


MVAT 180 


E7=1.0E-T,. 


MVAT 190 


A(l,l)=A(l,l»-EIG,. /• MODIFY DIAGONAL ELEMENTS 


*/MVAT 200 


IS< l)-l,. 


MVAT 210 


U=ABSUIl,l)l,. /♦COMPUTE A NORM OF THE MATRIX 


♦/MVAT 220 


00 1=2 TO N,. 


MVAT 230 


11=1-1,. 


MVAT 240 


IS(I>=I1.. 


MVAT 250 


AII,I1=AII,I1-EIG,. 


MVAT 260 


T=ABSiAllf I)),. 


MVAT 270 


IF T GT U THEN U=T,. 


MVAT 280 


00 J=I1 TO N,. 


MVAT 290 


T=A6StA(I,J)).. 


MVAT 300 


IF T GT U THEN U=T,. 


MVAT 310 


END,. 


MVAT 320 


END,. 


MVAT 330 


EPS=U*E7,. 


MVAT 340 


N1=N-1,. /• START FACTORIZATION 


♦/MVAT 350 


P11)='0'B,. 


HVAT 360 


IF ABS1A(2,1»1 GT ABSIA(1,1)1 /* INITIALIZATION 


♦/MVAT 370 


THEN 00,. 


HVAT 380 


p(n=«i'B.. 


MVAT 390 


DO 1=1 TO N,. 


MVAT 400 


C=A(1.I>,. 


HVAT 410 


A(1,I)=A(2,I>,. 


MVAT 420 


A^2,I)=C,, 


MVAT 430 


END,. 


HVAT 440 


END,. 


MVAT 450 


IF ABS(A(1,1I» LT EPS THEN A(l,l)=EPS,. 


MVAT 460 


A(2,L)=AI2,1)/A(l,l)t. 


MVAT 470 


DO K=2 TO Nl,, 


HVAT 480 


KP1=K+1,. 


MVAT 490 


K1=K-1,. 


MVAT 500 


S=AIK,K),, /♦ COMPUTE THE LOWER FACTOR 


♦/MVAT 510 


00 IsIS(K) TO Kl,. 


MVAT 520 


S=S-MULTIPLY(A(K,I»,A(I,K»,5^I,. 


HVAT 530 


END,. 


MVAT 540 


A(K,K)=S,. 


MVAT 550 


IF ABS(A{K,K)) LT ABSI A( KPl,K) 1 


MVAT 560 


THEN DO.. /• PIVOTING 


♦/MVAT 570 


PtK)=»l'8,. 


MVAT 580 


DO I=K TO N, . 


MVAT 590 


C=AtKtI),. 


HVAT 600 


A(K,II=A(KP1,I ).. 


MVAT 610 


A(KP1,II=C,. 


MVAT 620 


END,. 


MVAT 630 


DO I=IS(K) TO Kl,. 


HVAT 640 


A(KPl,n=AIK,I),. 


MVAT 650 


END,. 


MVAT 660 


I=IS(K».. 


MVAT 670 


IS(K»=ISIKP1I,. 


MVAT 680 


IS(KPl)=I,. 


MVAT 690 


END,. 


MVAT 700 


ELSE DO,. 


HVAT 710 


P1K)='0*B,. 


MVAT 720 


00 J=KP1 TO N, . /* COMPUTE THE UPPER FACTOR 


♦/MVAT 730 


S=A(K,J),. 


MVAT 740 


00 I=ISIK) TO Kl,. 


MVAT 750 


S=S~MULTIPLY<A(I,J),A(K,I),53I,. 


MVAT 760 


END.. 


MVAT 770 


AtK,JI=S,. 


MVAT 780 


END.. 


MVAT 790 


END.. 


MVAT 800 


/* NORMALIZE THE LOWER FACTOR 


*/MVAT 810 


IF ABS(AIK.K)) LT EPS THEN A(K,K)=EPS,. 


MVAT 820 


A(KP1,KI=A(KP1,K)/AIK,K).. 


MVAT 830 


END,. 


MVAT 840 


S=AtN.N).. 


MVAT 850 


DO I=.IS(N) TO Nl,. 


MVAT 860 


S=S-MULTIPLY(A<N,I),A(I,N},531.. 


HVAT 870 


END.. 


HVAT 880 


A(N.N)=S.. /* END FACTORIZATION 


♦/MVAT 890 


IF ABS(A(N,N)1 LT EPS THEN A(N,N1=EPS,. 


MVAT 900 


DO 1=1 TO N.. /* INVERSE ITERATION 


♦/MVAT 910 


V(n = l.. /* STARTING VALUE 


♦/HVAT 920 


END.. 


HVAT 930 


00 IT='1,2.. 


HVAT 940 


K-Nf. 


HVAT 950 


IF IT GT 1 


HVAT 960 


THEN 00,. 


HVAT 970 


DO 1=1 TO Nl,. /* INTERCHANGES 


♦/MVAT 980 


IF Pin 


HVAT 990 


THEN DO,. 


MVAT 1000 


11=1+1.. 


MVAT 1010 


C=VtI),. 


HVAT 1020 


V(I)=V(I11.. 


HVAT 1030 


VII1)=C,. 


MVAT 1040 


END,. 


MVAT1050 


END.. 


MVAT 1060 


DO 1=2 TO N,. /* SOLVE WITH LOWER FACTOR 


♦/MVAT 1070 


s=vm,. 


HVAT 1080 


DO J=IS(II TO I-l,. 


MVAT 1090 


S=S- MULTIPLY (All, J), VI J), 53),. 


MVAT 1100 


END.. 


MVATlllO 


V(I)-S,. 


HVAT 11 20 


END.. 


HVAT 1130 


END,. 


MVAT 11 40 


V(N)=V(N>/A(N,N)t . /* SOLVE WITH UPPER FACTOR 


♦/MVAT 1150 


U=ABS(VIN) ),. 


MVAT 1160 


00 I=N1 TO 1 BY -I,. 


MVAT1170 


S=V(II,. 


HVAT 11 80 


DO ^=1+1 TO N,. 


MVAT 1190 


S-S-MULTIPLYIA(I,J),V(JI,53),. 


MVAT 1200 


END,. 


MVAT1210 





VII)=S/A(I,II.. 










T=ABSIV(n».. 






MVAT 12 30 




IF T GT U 






HVAT1240 




THEN DO.. 






MVAT 1250 










MVAT 1260 










MVAT1270 










MVAT 12 80 










HVAT 1290 










MVAT 1300 






/♦ 


NORMALIZE RESULTING VECTOR 






vtu =v(n/c,. 






MVAT 1320 










MVAT 1330 






/♦ 


END OF LOOP FOR ITERATION 












MVAT1350 






/♦ 


END OF PROCEDURE HVAT 


♦/HVAT 1360 



Purpose: 

For a given almost triangular complex matrix 
(Hessenberg), this procedure provides the eigen- 
vector corresponding to a given eigenvalue. 

Usage: 

CALL MVAT (A, N, EIG, V); 

A(N,N)- COMPLEX BINARY FLOAT 

Given almost triangular matrix. 

N - BINARY FIXED 

Given order of the matrix. 

EIG - COMPLEX BINARY FLOAT 

Given eigenvalue. 

V(N) - COMPLEX BINARY FLOAT 

Resultant vector containing the eigen- 
vector corresponding to EIG. 

Remarks: 

The original matrix is destroyed. 

Method: 

Melandt's inverse iteration is applied to the matrix, 
using the given eigenvalue as a shift. 

For reference see: 

J. H. Wilkinson, The Algebraic Eigenvalue 
Problem , Clarendon Press, Oxford, 1965. 

Mathematical Background: 

For a given nonsingular matrix A, the inverse 
iteration is defined by the following process: 

V^-"^^ = A"' V<P> 

where v' ' is an arbitrary starting vector. We 
know that when P -><» , imder certain conditions 
V^' tends to an eigenvector V associated with the 
smallest eigenvalue A o of the matrix A. 

When converging to V, the speed of convergence 
can be substantially improved by shifting the origin 
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of the eigenvalues close to Xq. Then the iteration 
can be written as 



Then the first iteration will consist of solving 
equation (4) only: 



V(P^1) = (A-XD-S(P) 



(1) 



RV<^) = e 



where K is the value of the shift. 

When we know an approximation A. of Xq, the 
above properties of the inverse iteration can be 
used for finding the corresponding eigenvector V 
by means of equation (1). 

The closer X is to Xq. the faster V^P) converges 
to V. If X has been obtained with good accuracy, 
V can be obtained using only a few steps of inverse 
iteration. 

Each step of iteration is equivalent to finding the 
solution of the equation 



Only two iterations are performed. Most of the 
time they are quite sufficient to provide an accurate 
approximation of the eigenvector V. 



(A- XI) V<P^1) = V^) 



(2) 



Considering a triangular factorization of A - X I, 
A - XI = LR, the solution of equation (2) will be 
provided by solving successively 



LW 



r(P) 



RV(P^1> = 



W 



(3) 



(4) 



where L and R are lower and upper triangular 
matrices. The triangular decomposition has to be 
performed only once before starting the iterative 
process , and the iteration is carried out by solving 
equations (3) and (4). 

Programming Considerations: 

A technique of partial pivoting by row interchange 
is included in the process of triangular factoriza- 
tion. This pivotii^ is obviously convenient in two 
ways; it is economical and does not modify the 
special structure of the matrix. Thus, it will be 
possible to take advantage of this structure in the 
factorization of the matrix, as well as in the 
solution of equation (3). 

Since the starting vector is arbitrary, we choose 
it so that 



V^^^ = Le, W = e, 



where: 



e = (1, 1 1) 
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• Subroutine MVSU 



Method: 



HVSU.. 



MVSU 
**«*«**•*{•*««***«*«*************«**«****/ HVSU 

*/MVSU 

B«CK TR«NSFaRH«IION OF THE EIGENVECTORS */HVSU 

SYMMETRIC CASE */MVSU 

•/MVSU 
/««»•«♦•»««•**•«♦*♦••*•♦*••♦*♦****•••***♦♦*♦•**••*♦*♦** *****«*********/MVSU 
PROCEDURE (A.NtCO.V).. 
DECLARE 

(A<<l,CDI<I.VI«liT,C) BINARY, 
(M,N,IC0,K,KP1,KP2,J,I,L) BINARY FIXED 
IS, DPI BINARYI53I,. 
ICD=(N*IN*U»/2-l,. 

00 K=N-l TO 2 BY -1,. 
KPl'K+l, . 
IC0=ICD-KP1,. 
C=A(ICD1-C0(K»,, 
IF C NE 



THEN 00, 
S=0, 



/* ORTHOGONAL TRANSFORMATION 



"ICD-K+1,. 

DO I-K TO N,. 

J-J+I-1,. 

S-S»MULTIPLY(A( J I , VI 1 1 , 531 • 

END,. 
S-S/CDIKl,. 
T=IS-VIK)I/C,, 
VIK)-S,. 
J'ICO,. 

DO I»KP1 TO N,, 

J-J«I-1,. 

VIII-VIII»T«AIJ),. 

END,. 



END, 
S"0, 



=1 TO N,. 
DP=VI II ,. 
S=S+DP*DP, . 
END,. 
=SORTISI.. 

DO I" I TO N,. 
Vlll=VIII/S,. 
END,. 



RETURN. 
END,. 



END OF PROCEDURE MVSU 



HVSU 80 
HVSU 90 
HVSU 100 
HVSU 110 
MVSU 120 
MVSU 130 
MVSU 140 
HVSU 150 
MVSU 160 
MVSU 170 
HVSU 180 
♦/HVSU 190 
HVSU 200 
MVSU 210 
MVSU 220 
HVSU 230 
MVSU 240 
MVSU 250 
MVSU 260 
HVSU 270 
HVSU 280 
MVSU 2S0 
MVSU 300 
MVSU 310 
HVSU 320 
HVSU 330 
MVSU 340 
MVSU 350 

♦/MVSU 360 
HVSU 370 
HVSU 380 
MVSU 390 
MVSU 400 
HVSU 410 
HVSU 420 
MVSU 430 
MVSU 440 
HVSU 450 

♦/HVSU 460 



The eigenvector of the almost triangular matrix 
H is transformed according to the unitary similar- 
ities applied to matrix M in procedure MSTU. 

For reference see: 

J. H. Wilkinson, The Algebraic Eigenvalue Problem , 
Clarendon Press, Oxford, 1965. 

Mathematical background: 

For a symmetric matrix M of order n that has been 
reduced to the tridiagonal matrix H by similarities, 
we have a relation of the form 

H = P'^^'MP 

and an eigenvector of M, X(M) corresponding to an 
eigenvector of H, X(H) according to 



H(M) = P ♦ X(H) 



(1) 



Purpose: 

For a given symmetric matrix M that has been 
reduced to a similar tridi£^onal symmetric matrix 
H by procedure MSTU, MVSU gives the eigenvector 
of M corresponding to a given eigenvector of H. 

Usage: 

CALL MVSU (A, N, CD, V); 



A(N*(N+l)/2) 



N 



CD(N) 



V(N) 



BINARY FLOAT 

Given vector whose elements are 

set up by procedure MSTU. 

BINARY FIXED 

Given order of the original matrix 

M. 

BINARY FLOAT 

Given vector containing in positions 

2, 3, . . . , N the codiagonal terms 

of the tridiagonal matrix. 

BINARY FLOAT 

Given eigenvector of the tridiagonal 

matrix. Resultant eigenvector of 

the original matrix. 



In procedure MSTU, P consists of the product of 
(n-2) Householder's matrices: 



P = P. 



^2 V2 



(2) 



1 b(v. 



^ (V - be.^^) (V - be.^/ 



i+1 

where the vector v and the scalar b have been defined 
in the transformation of the i-th column of the 
given matrix in procedure MSTU. 

P will thus be applied to X(H) by means of (n-2) 
successive transformations, Pn_2> ^n-l' ••" ^1' 
according to equations (1) and (2). 

The elements v and b defining each P^ are trans- 
mitted to MVSU through the parameters A and B. 



Remarks: 



See procedure MSTU. 
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• Subroutine MVUB 



Method: 



/*•#♦*»••»»»**«*«*#««♦,»*»»»**#»«*«»»,*,*,«*#* i,^,^,^^^,^^,^^^^,^,^^^^, 



BACK TRANSFORMATION OF THE EIGENVECTORS 
HOUSEHOLDER'S TRANSFORMATIONS 



PROCEDURE lA.N.B.V),. 
DECLARE 

IA(*,*) ,B(*),T,U) 8INARY, 
(ItK.Kl.KPl.N) BINARY FIXED 
IV(»),X) COMPLEX BINARY, 
S COMPLEX eiNARY(53}(. 
00 K=N-l TO 2 BY -1,. 
IF B(K) NE 
THEN DO.. 

KPl=K*l,. 
Kl=K-l,. 

S:=MULTIPLY(BCK>,V(KI.53) ,. 
00 I^KPI TO Ni. 
S=S*MULTIPLY{At I.Kl»,V(I),53) 
END,. 
S=S/AtK,KU.. 

X=(S-V(K))/(B(K)-A(K,Kn),. 
V1K)=S,. 

DO I=KPl TO N,. 
VII)=V(n+X*A(I,Kl),. 
END,. 
END.. 
END.. 

T=ABS(V(in,. /* 

DO 1-2 TO N,. 

U-ABS(Vin),. 

IF U GT T 

THEN 00.. 
T=U.. 
R=I,. 
END*. 

END.. 
X =V(K»,. 

DO 1:^1 TO N,. 

V(II =V(U/X.. 

END.. 
RETURN,. 
END. . 



«***«**«:« *««•««*«*«*« *««««4,«**«**« 



ORTHOGONAL TRANSFORMATION 



END OF PROCEDURE HVU8 



MVUB 10 
**/HVUB 20 
•/MVUB 30 
*/MVUB 40 
•/MVUB 50 
•/MVUB 60 
•/MVUB 70 
MVUB 60 
MVUB 90 
MVUB 100 
MVUB 110 
MVUB 120 
MVUB 130 
MVUB 140 
MVUB 150 
♦/MVUB 160 
MVUB 170 
MVUB 180 
MVUB 190 
MVUB 200 
MVUB 210 
MVUB 220 
MVUB 230 
MVUB 240 
MVUB 250 
MVUB 260 
MVUB 270 
MVUB 280 
MVUB 290 
MVUB 300 
MVUB 310 
•/MVUB 320, 
MVUB 330 
MVUB 340 
MVUB 350 
MVUB 360 
MVUB 370 
MVUB 380 
MVUB 390 
MVUB 400 
MVUB 410 
MVUB 42 
MVUB 430 
MVUB 440 
MVUB 450 
•/MVUB 460 



The eigenvector of the tridiagonal matrix H is 
transformed according to the xmitary similarities 
applied to the matrix M in procedure MATU. 

For reference see: 

J. H. Wilkinson, The Algebraic Eigenvalue Problem, 
Clarendon Press, Oxford, 1965. 

Mathematical background: 

For a matrix M of order n that has been reduced to 
the almost triangular matrix H by similarities, we 
have a relation of the form 

H = P'-^MP 

and an eigenvector of M, X(M) corresponding to an 
eigenvector of H, X(H) according to 



X(M) = P • X(H) 



(1) 



Purpose: 

For a given matrix M that has been reduced to a 
similar almost triangular matrix H by procedure 
MATU, MVUB gives the eigenvector of M cor- 
responding to a given eigenvector of H. 

Usage: 



In procedure MATU, P consists of a product of (n-2) 
Householder's matrices: 



P = P 



P. 



1 

I + 



n-2 



(2) 



^^^^^) (^-^W<^-''W* 



CALL MVUB (A, N, B, V); 

A(N, N) - BINARY FLOAT 

Given two-dimensional array whose 

elements are set up by procedure MATU. 
N - BINARY FIXED 

Given order of the matrix. 
B(N) - BINARY FLOAT 

Given vector whose components are 

provided by procedure MATU. 
V(N) - COMPLEX BINARY FLOAT 

Given eigenvector of the almost triangular 

matrix. 

Resultant eigenvector of the original 

matrix. 



where the vector v and the scalar b have been defined 
in the transformation of the i-th column of the given 
matrix in procedure MATU. 

P will thus be applied to X(H) by means of (n-2) 
successive transformations, Pn_2. ^n-l' •••> ^i' 
according to equations (1) and (2), 

The elements v and b defining each Pj are trans- 
mitted to MSTU through the parameters A and B. 



Remarks: 

See procedure MATU. 
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• Subroutine MVEB 



Method: 



«»EB.. 




MVEB 


10 




«««««««««»aa«M«»«««»«M»<«n««,.«.*«««,...,/MvEB 


20 


/• 




•/MVEB 


30 


/* BACK TRANSFORMATION 


OF THE EIGENVECTORS '/MVEB 


«0 


/* 


ELIMINATION 


TECHNIQUES */MVES 


50 


/• 




•/MVEB 


60 


/***********»**««**•**•****«»*******«««*•**««*•******»«***•****«****** /HVE6 


70 


PROCEDURE (A.N.ICV), 




MVEB 


80 


DECLARE 




MVEB 


to 


IA(*t*J,T,U» BINARY, 


MVEB 


100 


IVI»I,CI COMPLEX 


BINARY, 


MVEB 


110 


(IP<«).I.K,K1,N] 


BINARY FIXED, MVEB 


120 


S COMPLEX BINARYI53),. 


MVEB 


130 


DO K=2 TO N-l,. 




MVEB 


140 


Kl-K+1.. 




MVEB 


150 


IF AlKl.KI NE 




MVEB 


160 


THEN 00,. 




/• ELEMENTARY TRANSFORMATION •/MVEB 


170 


S=V(KI.. 




MVEB 


160 


00 I-l 


TO K-1,. 


MVEB 


190 


S=S-MULTIPLy(A(Kl 


1), VII), 53),. MVEB 


200 






MVEB 


210 






MVEB 


220 


END,. 




MVEB 


230 


END,. 




MVEB 


2*0 


DO K.2 TO N-l,. 




MVEB 


250 


IF IP(K) NE K 




/« INTERCHANGES •/MVEB 


260 


THEN 00,. 




MVEB 


270 


I-IP(K1,. 




MVEB 


280 


CVIKl,. 




"VE6 


290 


V<K)=V(I),. 




MVEB 


300 


V(I)=C,. 




MVEB 


310 


END,. 




MVEB 


320 


END,. 




MVEB 


330 


K>1,. 




MVEB 


340 


T-ABSfVUM,. 




/• NORMALIZE •/MVEB 


350 


DO 1=2 TO N,. 




MVEB 


360 


U-ABSI»tII)>. 




MVEB 


370 


IF U GT T 




MVEB 


3B0 


THEN DO.. 




MVEB 


390 


I=U,. 




MVEB 


400 


K>I,. 




MVEB 


410 


END,. 




MVEB 


420 


END,. 




MVEB 


430 


C -VIKI,. 




MVEB 


440 


DO 1=1 TO N,. 




MVEB 


450 


»III =VIII/C,. 




MVEB 


460 


END,. 




MVEB 


470 


RETURN,. 




MVEB 


4B0 


END,. 




/• END OF PROCEDURE MVEB "/MVEB 


490 



Purpose: 

For a given matrix M that has been traasformed to 
a similar almost triangular matrix H by procedure 
MATE, MVEB gives the eigenvector of M cor- 
responding to a given eigenvector of H. 

Usage: 

CALL MVEB (A, N, IP, V); 

A(N, N) - BINARY FLOAT 

Given two-dimensional array whose 

elements are set up by procedure MATE. 
N - BINARY FIXED 

Given order of the almost triangular 

matrix. 
IP(N) - BINARY FIXED 

Given vector whose components are 

provided by procedure MATE. 
V(N) - COMPLEX BINARY FLOAT 

Given eigenvector of the almost triangular 

matrix. 

Resultant eigenvector of the original 

matrix. 



The eigenvector of the almost triangular matrix is 
transformed according to the similarities applied to 
the matrix M in procedure MATE. 

For reference see: 

J, H, Wilkinson, The Algebraic Eigenvalue Problem , 
Clarendon Press, Oxford, 1965. 

Mathematical background: 

We know that a given matrix M of order n can be 
reduced by similarity to an almost triangular matrix 
H. This can be written as 

H = SMS' 

Then, for a given eigenvalue of both M and H, the 
corresponding eigenvectors V of M and W of H are 
related by the equation 

V = s"V 

The transformation S is defined here as the product 
of a triangular matrix T with unit diagonal by a 
permutation matrix P which was operating on the 
rows of M according to the pivoting used in procedure 
MATE. 

The elements of the matrix T are transmitted to 
the procedure through the array A. The permuta- 
tion matrix P is defined by the information contained 
in vector IP. 

Then V is provided by 

V = PX 

where the vector X is the solution of the equation 
TX = W 



Remarks: 



See procedures MATE and MVAT. 
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Polynomial Operations 
• Subroutine POV 



POV.. 










POV 


10 


/**mm*********it********:******0*** 


*« 


******»m********************»*****/POV 


20 


/* 










*/POV 


30 


/* 


CALCULATE VALUES OF 


FIRST 


N 


ORTHOGONAL POLYNOMIALS 


•/POV 


40 


/* 










•/POV 


50 


/*****»*.*it:*********»*»*mm****»*******«*******9***9*****9**************/po\i 


60 


PROCEOUREU.N.OPT.Y),. 








POV 


70 


DECLARE 








PPV 


80 




(LXtH,HCtHl,H2,FN} 


BINARY 


FLCAT(S3», 


POV 


90 




(Y(»),X1 








POV 


100 




BINARY FLOAT, 






/♦SINGLE PRECISION VERSION /*S*/POV 


no 


/* 


BINARY FL0AT{53), 
(N,n BINARY fIXED, 
OPT CHARACTERUl,. 






/•DOUBLE PRECISION VERSION /* 


D*/PDV 
POV 
POV 


12C 
130 

1« 


LX 


= X.. 








POV 


150 


IF N 


GE 1 






/♦BYPASS OPERATION IF N LE 


♦ /POV 


160 


THEN 


00,. 








POV 


170 




IF OPT-«T' 






/•CHE6YSHEV POLYNOMIALS TtXI 


«/POV 


180 




THEN HO -LX,. 






/*INIT. STARTING VALUE 


*/POV 


19C 




ELSE 00,. 








POV 


200 




FN -1,. 






/*INIT. INTEGER FACTOR TERM 


♦/POV 


21C 




HO =0,. 






/*INIT. STARTING VALUE 


*/POV 


220 




END,. 








POV 


230 




Yll) ,H1=1,. 






/♦STORE AND SAVE FIRST RESULT 


*/pnv 


240 




00 1 = 2 TO N, 








POV 


250 




M2 *LX*Hl,. 






/•PERFORM COMMON CALCULATION 


• /POV 


260 




H -H2-H0,. 








POV 


270 




IF OPT NE 'T' 






/•CHEBVSHEV POLYNOMIALS T(X) 


•/POV 


280 




THEN 00,. 








POV 


290 




IF OPT* • 


H* 




/•HERMITE POLYNOMIALS H(X» 


• /POV 


300 




THEN DO,. 








POV 


310 




H2 


*H2*FN*HC,. 


POV 


320 




FN 


-FN-2 




/♦STEP INTEGER FACTOR 


•/pnv 


330 




END. 








POV 


340 




ELSE DO,. 








POV 


350 




IF OPT- 'L 




/•LAGUERRE POLYNOMIALS L(X) 


♦ /POV 


360 




THEN 


00,. 






POV 


370 






H2 *H1 


-)H*Hll/FN,. 


POV 


360 






H = 


HI 


-HO,. 


pnv 


390 






END,. 






POV 


400 




ELSE 


H2 
-H/FN 


H2 


/♦LEGENDRE POLYMOMIftLS P(X) 


*/POV 
POV 


410 
420 




FN 


-FN»l 


, 


/•STEP INTEGER DENOMINATOR 


•/OOV 


430 




ENO, 








POV 


440 




ENO,. 






/•CONTINUE COMMON CALCULATION 


• /POV 


450 




HO =H1,. 






/♦SAVE PRECEDING RESULT VALUE 


• /POV 


460 




H1,Y1I)-H+H2,. 






/•STORE AND SAVE I-TH RESULT 


• /POV 


470 




END,. 








POV 


480 




END,. 








POV 


490 


ENO, 








/•END OF PROCEDURE POV 


«/POV 


500 



Remarks: 

Operation is bypassed if N is not positive. Any input 
value of OPT other than 'T', 'L', or 'H' is treated 
as if it were 'P'. The values of the shifted poly- 
nomials of Chebyshev or Legendre for argument 
X are obtained as values of non-shifted polynomials 
for the argument (2 ♦ x - 1). 

Method: 

Evaluation is based on the three-term recurrence 
relation for orthogonal polynomials. 

For reference see; 

Jahnke-Emde-Loesch, Tables of Higher Functions , 
B. G. Teubner, Stuttgart, 1960, pp. 96-114. 
M. Abramowitz and I, A. Stegun, Handbook of 
Mathematical Fimctions , Applied Mathematics 
Series 55, National Bureau of Standards, 1964, 
pp. 771-803, 

Mathematical Background: 

The orthogonal polynomials are defined by the fol- 
lowing iteration scheme: 



Purpose: 

POV computes the values of the first n orthogonal 
poljmomials. The user has the choice of 



Chebyshev polynomials 



Vx)=l 



\(x) 



Chebyshev polynomials (Tq, T^, ..., Tjj_j) with 
OPT = 'T' 

Legendre polynomials (Pq, Pi, ..., P^.j^) with 
OPT = 'P' 

Laguerre polynomials (Lq' ^1' •••' ^n-l^ ^*^ 
OPT = 'L' 

Hermite polynomials (Hq, H-,^ H , ) with 

OPT = 'H' 



Usage: 

CALL POV (X, N, OPT, Y); 

X - BINARY FLOAT [(53)] 

Given argument of the orthogonal polynomials 
N - BINARY FIXED 

Given number of orthogonal polynomials to be 
calculated. 
OPT - CHARACTER (1) 

Given parameter of choice (see "Purpose") 
Y(N) - BINARY FLOAT [(53)] 

Resultant vector containing the values of the 
first N orthogonal polynomials. 



\(^) 



Tj(x)=x 



\+i<^> = 2^ Tk<^) - Vi<^) 



Laguerre polynomials 



Po(x) = 1 



Pj(x)=x 



(k+l)Pj^^^(x) = (2k+l)xP^(x) - kP^_j(x), 
for k = 1, 2, . . . 



for k = 1, 2, . 



Laguerre polynomials 



Lo(x) = 1 



L (x) =l-x 



Lj^(x) 
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^^^^^^k+l<^^ " (^^"^^ " ^) ^k ^^^ " '^^k-l^^^ 



• Subroutine POSV 



for k = 1, 2, . . , 



Hermite polynomials 



E^ix) = 1 



Hj(x) = 2x 



H^(x) 



, • • • 



Hj^^^(x) = 2xH^(x) - 2kH|^_^(x) , for k = 1, 2 
Programming Considerations: 



For reasons of programming efficiency and for 
diminishing roundoff errors, the recurrence rela- 
tions are modified to the following forms: 

Chebyshev polynomials 



T_^=x. T^=l, T^^^=xT^-Tj^_^H.xTj^ 



fork = 0, 1, 2, . . . , n-2 
Legendre polynomials 



P_l = 0, Pq = 1, 



^k+i =^VPk-r<^VPk-i)/<k^i)-^-Pk 

for k = 0, 1, 2, . . . , n - 2 
Laguerre polynomials 



L_^=0, L^ = l, 



for k =0, 1, 2, , . . , n - 2 
Hermite polynomials * 



H_^=0, Hq=1, 



"k+1 =^«k-Vl-<2k-l)Hk-i + -Hj^ 



for k = 0, 1, 2, . . . , n-2 













POSV.. 












♦ /POSV ?ii I 




EVALUATE N-TERM SERIES EXPANSION IN ORTHOGONAL POLYNOMIALS 


^/i'OSV 40 1 




***«****«***«««,**««***« 


♦/*>OSV 50 


PR0C60URE1X.C,N,0PT,SUM),. 
DECLARE 

(l.X,H,H0,Hl,H2,fN) BINARY FLrAT153), 


PDSV 7C 
P"SV 80 
pn«:u on 




IX, CI*), SUM) 
BINARY fLOAT, 


POSV 100 
/•SINGLE PRECISION VERSION /*S*/POSV 110 


/• 


BINARY FLOATI53). 


/•DOUBLE PRECISION VERSION /*0*/Pr)SV 120 




(N,I) BINARY fIXED, 




POSV 130 
POSV UO 




OPT 

'Nt. 


CHARACTER(X) ,. 




I 

IF 
THE^ 






POSV 150 


GE I 
OOt. 
LX 


"Xt. 


/•BYPASS OPERATION IF N LE 


♦/POSV 160 
POSV 170 






POSV 180 




IF apT='L ' 


/•LAGUERRE POLYNOMIALS LIX) 


•/POSV 190 




THEN 


LX -l-LX,. 




POSV 200 




H2,Hi«u,. 


/•ZERO UlN+l), UIN+2) OR V(N*2I»/P0SV 21C 1 


ITER., 


FN 


■it* 




POSV 220 






/♦LOOP OVER I • N TO I BY -1 


•/POSV 230 




IF Opi»'T' 
THEN 00,. 


/•CHE9YSHEV POLYNOMIALS T(X1 


♦/POSV 2*0 
POSV 250 






HO =LX«H1,. 




POSV 260 






H »H0-H2*-H0.. 


/*H ■ 2*X*UtI*l»-U(l*2) 


♦/POSV 270 






END, . 




POSV 280 




ELSE 


DO,. 




POSV 290 






IF OPT-'H' 


/•HERMITE POLYNOMIALS HtXl 


*/POSV 300 






THEN DO,. 




POSV 310 






H -LX*HX-FN*H2, 




POSV 320 






H -H+H , . 


/•H » 2*(X*U(I«-U-I*U(I + 2II 


♦/POSV 330 






END,. 




POSV 340 






ELSE DO,. 


/♦LAGUERRE OR LEGENDRE POLYNOM 


.♦/POSV 350 






HO >H1,. 


/♦SAVE U(I4-1) 


*/POSV 360 






H -Hl/FN,. 




"OSV 370 






HI -Hl-H,. 


/♦COMPUTE V(l*l) 


♦/POSV 380 






IF OPT"»L' 


/♦LAGUERRE POLYNOMIALS LIXl 


•/POSV 390 






THEN H ■H1*LX*H+Hl 


./*H - 2^VII+1>+(1-XI*UII*I1 


♦/POSV 400 






ELSE H -LX«CH1+HC) 


./•LEGENORE POLYNOMIALS L(X» 


♦/POSV 410 






H "H-HZ,. 


/•H - X*(V(I*ll+U(I*U) 


♦/POSV 420 






END,. 


/•FOR BOTH H • H-V(l*21 


♦/POSV 430 






FN =FN-l,. 


/•DECREASE INTEGER FACTOR 


♦/POSV 440 






END,. 




POSV 450 




H2 


■HI,, 


/•SAVE UCI*ll RESP, V(I*n 


♦/POSV 460 




HI 


-H*C(II,. 


/•COMP. U(I) « H+C( I) 


♦/POSV 470 




I 


-1-1,, 


/•DECREASE COUNTER 1 


♦/POSV 480 




IF I 


GT 




POSV 490 




THEN 


GO TO ITER.. 


/♦END OF LOOP OVER I 


♦/POSV 500 




IF OPT«»T' 




POSV 5t0 




THEN 


HI -Hl-HO,, 


/♦MODIFY Ull) IN CHEBYSHEV CASE^/POSV 520 | 




SUM 


"HI.. 


/♦RETURN VALUE OF SERIES 


•/POSV 530 




END, 






POSV 540 


END* 






/♦END OF PROCEDURE POSV 


♦/POSV 550 



Purpose : 

POSV computes the value of the svun 

N 
^ Vk-1^^^ *°^ ^ ^^^^ vector C = (c^, c^, . . , , c^), 

K — X 

and a specified set of orthogonal polynomials (f. ). 

The user has the choice of 

Chebyshev polynomials (T T "^n-I^ 

with OPT = 'T' 



Legendre polynomials (Pq.Pj^ ^N-1) 

with OPT = 'P' 



Laguerre polynomials (L , L , . . . , L .) 
with OPT ='L' 

Hermite polynomials (H , H ^n-I^ 

with OPT = 'H' 
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Usage: 

CALL POSV (X, C, N, OPT, SUM) ; 

X - BINARY FLOAT [(53)] 

Given argument of orthogonal polynomials . 
C(N) - BINARY FLOAT [ (53) ] 

Given coefficient vector of series expansion. 
N - BINARY FIXED 

Given dimension of coefficient vector. 
OPT - CHARACTER (1) 

Given parameter of choice (see "Purpose"). 
SUM - BINARY FLOAT [(53)] 

Resultant value of series expansion for 

argument X. 



Then 



n n 

Z c.T. , =y, c.T. , +U ^,T - U ,„• T , 

f-L 11-1 r-^ 1 1-1 n+1 n n-i-2 n-1 

1=1 1=1 



n-1 



= Y; C.T. , + (c + 2xU ^, - U .„) T 
I'-i 11-1 ^ n n+1 n+2' n-1 

1=1 



U T 
^n+1 n-2 



n-1 



= X) C.T. , +U T , U ^, T ^ 
ri 1 1-1 n n-1 - n+1 n-2 
1=1 



Remarks: 



Operation is bypassed if N is not positive. Any in- 
put value of OPT other than 'T', 'L', or 'H' is 
treated as if it were 'P'. 

The sum of an expansion in shifted Chebyshev or 
Legendre polynomials for argument x is obtained 
as the value of the expansion in non-shifted poly- 
nomials for argument (2 • x - 1). 

Method: 

Evaluation is based on the three-term recurrence 
relation for orthogonal polynomials, using a back- 
ward iteration scheme. 

For reference see: 

M, Abramowitz and I, A. Stegun, Haadbook of 
Mathematical Functions . Applied Mathematics 
Series 55, National Bureau of Standards, 1964, 
pp. 771-803. 



= °1^0"Vl-V0=^l^^U2-U3 



Legendre expansion 



Set U . , =U „ = and use the recurrence relations 
n+1 n+2 



kP^ = x(2k-l)P^_^-(k-l)Pj^_^ 



(k-l)U^ = c^+x(2k-l)U^^^-kU^^2 



successively for k = n, n-1, . . . , 2. Then: 

n n 

E c.P. ^ = X; c.P. +U ^, . nP -nU ^^ . P , 
._j 1 1-1 r^- 1 1-1 n+1 n n+2 n-1 

n-1 
= E c.P._j + (c^+x(2n-l)U^^j -nUj^+2) ^n-J 



Mathematical Background: 

Evaluation is based on the following iteration 
schemes: 

Chebyshev expansion 



U ,(n-l)P „ 
n+1^ ' n-2 



n-1 



= L c.P. , +U (n-l)P -(n-1) 
. 1 11-1 n n-1 ' 

1=1 



Set U^_|^j^= U^^2 = ^ ^^fl use the recurrence 



U , • P „ 
n+1 n-2 



relations: 



= Vo" ^2-^1-^3 Po^^-^'^Ua- ^^3 



\=^''\-l-\-2'\=\^^-\^l-\^2 



Laguerre expansion 



successively for k = n, n-1 2. 



Set U = U = and use the recurrence 
n+1 n+2 
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relations kL = (2k-l-x)L -(k-l)L 



k-2 



sucessively for k = n, n-1, . . . , 2. Then: 

n n 

E c.L. , = X) c.L. , + U _^ • nL - nU ^„L 
., 11-1 r-1 1 1-1 n+1 n n+2 n 
1=1 1=1 

n-1 

= Z c.L. , + (c + (2n-l-x)U ^, 
r-i 1 1-1 ^ n ^ ' n+1 

1=1 

-nU ^„) L , - (n-l)U ,,L „ 
n+2' n-1 ^ ' n+1 n-2 

n-1 
= 5^ ^i Vl ^ \ • (^-1) Vl 

-("-^)U^+lV2 



h%^''2'''i-^Vo 



= c^ + 2XU2 - 2U3 



Programming Considerations: 

For reasons of programming efficiency the follov;'- 
ing modifications of the backward iteration scheme 
are used for evaluations: 

Chebyshev expansion 

Set: 



Vl=V2=« 



^i = ^^i+1 -^1+2 ^^Uj+i + c. for 1 = n 1 

Then: 



:c^ + U2(l-x)-U3 



Hermite Expansion 



Set U ~ U = and use the recurrence re- 
lations Hj^ = 2xHj^_^ - 2(k-l)Hj^_2 

U, = c, + 2xU, ^, - 2kU, ^„ 
k k k+1 k+2 

successively for k = n, n-1, , . . , 2. Then: 

n n 

Z c.H. = X; c.H. , + U ^, H - 2nU ^„* H , 
. 1 1 1-1 , 1 1-1 n+1 n n+2 n-1 

1=1 1=1 

n-1 

= E c.H. , +(C + 2xU ^, - 2nU ^„)h 
fZ^ 11-1 n n+1 n+2' n-1 



2(n-l)U _,. • H „ 
n+1 n-2 



L c.T._^(x) = U^ -xU^ 
Legendre expansion 



Set: 



Vl=\+2=« 



^i+1 = Vl - UiH-l/i ^ 



Ui=x(V.^,-U.^^)-V.^2 \fori=n, . 

Then: 

n 
Z o.P._^(x)=U^ 

1=1 

Laguerre expansion 
Set: 



. . , 1 



n-1 

Z c.H. , +U • H , 
rr. 1 1-1 n n-1 
1=1 

-2(n-l)U^,H „ 
^ ' n+1 n-2 



U , =V „ =0 
n+1 n+2 



Vi = Vi-Ui+i/i 



U.=V.^^ + (l-x)U.^^/. + V.^^ 



^i+2-^^i \ 



for i = n 1 
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Then: 



• Subroutine PEC/PTC 



E o.L._^(x)=U^ 
1=1 

Hermite expansion 



Set: 



\^1=\^2=' 



U. = (xU. , - i • U. „) + (xU. , - iU. J 
1 ^ i+1 i+2' ^ 1+1 i+2' 



for i = n, . . . , 1 
Then: 



E c.H._,(x)=U^ 
1=1 



PEC. 






PEC 


10 


/*««** 


»**v»* ******************************************************** 


••/PEC 


20 


/« 






*/PEC 


30 


/* 


POLYNOMIAL ECONOMIZATION OVER 


THE RANGE 10, *1 IF OPT '' S' 


•/PEC 


*0 


/* 


AND OVER THE RANGE (-A,A) IF 


OPT =»0' 


• /PEC 


50 


/* 






♦/PEC 


60 


/»**** 


*«**«««*«** *»,*«««»««« «**«*****« 


««*«***********«*****************/PEC 


TO 


PROCEDURE (CN.M.TOt, EPS, A, OPT),. 




PEC 


80 


DECLARE 




PEC 


90 




(C(«I.A,FV,FX.FM,U..V,H} 




PEC 


100 




BINARY FLOAT, 


/♦SINGLE PRECISION VERSION /♦SVPEC 


llO 


/• 


BINARY FL0AT(531, 


/♦DOUBLE PRECISION VERSION /♦D*/PEC 


120 




(TOL.EPSIBINARY FLOAT, 




PEC 


130 




1N,M,NH,NT,JE,I,IC,N0D,JST,IST,J( 


PEC 


140 




BINARY FIXED, 




PEC 


150 




LN BINARY f IXED(31), 




PEC 


160 




(OPT. SW, ERROR EXTERNAL! CHARACTER ( 11 , . 


PEC 


170 


SM 


=■£',. 


/♦MARK ENTRY ECONOHIZATION 


• /PEC 


180 


EPS 


,M = 0,. 




PEC 


190 


GO 


TO COM,. 




PEC 


200 


PTC. 






PEC 


210 


/«««***** SAAAjK***************** ****** 


t^t:******wmm********** *********** /p^C 


220 








*/PEC 


230 




TRANSFORMATION OF POLYNOMIAL 


TO AN EXPANSION IN TERMS OF 


•/PEC 


240 




CHEBYSHEV POLYNOMIALS OVER THE RANGE (-A,A» IF OPT='0« AND 


•/P£C 


250 




SHIFTED CHEBYSHEV POLYNOMIALS 


OVER THE RANGE (OtA! IF OPT*»S 


'•/PEC 


260 








• /PEC 


270 


/«««*i|i*«AA««ft ««*»«»«* i|<«*«4[««««*«4i*«** 


******************************* 


••/PEC 


280 


FNTRY(C,N,A,PPT1 t. 




PEC 


290 


SM 


= 'T' ,. 


/♦MARK ENTRY TRANSFORMATION 


♦/PEC 


3C0 


COM.. 






PEC 


310 


LN 


= N, . 




PEC 


320 


IF 


LN LF 




PEC 


330 


THEN GO TO EXIT,. 


/♦GIVEN N IS NOT POSITIVE 


•/PEC 


340 


IF 


OPT NF 'S' 




PEC 


350 


THEN DOf . 




PEC 


360 




FV =1,. 




PEC 


370 




NH =LN/1CB,. 




PEC 


380 




JST =2,. 




PEC 


390 




NOD =LN-NH-NH,. 




PEC 


400 




END,. 




PEC 


410 


ELSE on,. 




PEC 


420 




FV =0.5,. 




PEC 


430 




NH =LN-l,. 




PEC 


440 




JST,NaD=l,. 




PEC 


450 




END,. 




PEC 


460 


FM, 


FX=FV*A6SU),. 




PEC 


470 


IF 


FX=0 




PEC 


480 


THEN GU TO EXIT, . 


/♦GIVEN A EQUALS ZERO, ERROR=» P 


'•/PEC 


490 


FV 


=0.5*FX,. 




PEC 


500 


NT 


=NH«NH,. 


/♦DIMENSION OF ARRAY T 


*/PEC 


510 




BEGIN,. 




PEC 


520 




DECLARE 




PEC 


530 




TINT! 




PEC 


540 




BINARY FLOAT,. 


/♦SINGLE PRECISION VERSION /♦ 


s»/pec 


550 


/* 


BINARY FL0ATI53),. 


/♦DOUBLE PRECISION VERSION /*0*/PeC 


560 




ERRaR='C',. 




PEC 


570 




JE =C,. 


/♦INIT, CALCULATION OF T-ARRAY 


♦/PEC 


5 8C 




W =2,. 




PEC 


590 




DO I -1 TO NT BY NH , . 




^EC 


600 




U,V,T(I)=1,. 


/♦INSERT ONE IN DIAGONAL 


*/PEC 


610 




IC =1,. 




PEC 


620 




JE =JEtNH,. 




PEC 


630 




I =1*1,. 




»EC 


64C 




DO J =! TO JE,. 


/♦INSERT REMAINING ELEMENTS OF 


♦ /PEC 


650 




IF I GT 2 


/♦SUBROH AND SUBCOLUMN 


♦ /PEC 


660 




THEN W =T(IC-n, 




PEC 


67C 




V,T1JJ=V+W,. 




PEC 


680 




IC =1C+NH,. 




PEC 


690 




U,T(IC)=U+V,. 




PEC 


700 




END,. 




fEC 


710 




ENO, . 




PEC 


720 




00 I =2 10 LN,. 


/♦SUBSTITUTION OF VARIABLE 


♦ /PEC 


730 




cm =C(I1*FX,. 




PEC 


740 




FX =FX*FV,. 




PEC 


750 




END,. 




PEC 


760 




IC =NT,. 


/♦INIT. FIRST TELESCOPING STEP 


«/P£C 


770 


TELE.. 






OEC 


700 




1ST =1,. 




PEC 


790 




I =IC,. 




PEC 


800 




IF NOD NE I 




OEC 


810 




THEN ISr =NH,. 




PEC 


820 




J =LN,. 




PEC 


830 




IF J =0 




PEC 


840 




THEN GO TO ENO,. 




PEC 


850 




U =C(LN1,. 




OEC 


860 




IF SH='E' 




PEC 


870 




THEN DO,. 




PEC 


880 




W =EPS+ABS(U),. 




PEC 


890 




IF H GT ABS(TOL) 




PEC 


900 




THEN DO,. 




PEC 


910 




M =LN,. 


/♦DIMENSION ECONOMIZED POLYNOM 


.♦/t»EC 


920 




DO I =2 TO LN, 




PEC 


930 




C(H =CU)/FM, 


./♦BACKSUBSTITUTION OF VflCiflBLE 


*/P£C 


940 




FM =FV*Fli,. 




PEC 


950 




END,. 




PEC 


960 




GO TO END,. 




PEC 


97C 




END,. 




°EC 


98C 




EPS =H,. 




PEC 


990 




END,. 




OEC 


1000 


SUBT.. 




/♦SUBTRACT MULTIPLE OF CHE8Y- 


*/PEC 


1010 




I =I-IST,. 


/♦SHEV POLYNOMIAL 


♦/PEC 


1020 




J =J-JST,. 




OEC 


1030 




IF J GT 1 




PEC 


1040 




THEN DO,. 




PEC 


1050 




CIJ! =C(J)*U*TIII,. 




PEC 


1060 




U =-u,. 


/♦ALTERNATE SIGNS IN T 


•/PEC 


1070 




GO TO SUBT,. 




PEC 


1080 




END,. 




PEC 


1090 




IF J = 1 




PEC 


HOC 




THEN CU) =C{1!*U,. 


/•ADJUST CONSTANT TERM 


*/PEC 


1110 




IF OPT NE *S< 




PFC 


1120 




THEN NOD =1-N0D,. 


/♦INIT. NEXT TELESCOPING STEP 


♦/PEC 


1130 




IF N0D=1 




»EC 


1140 




THEN IC =IC-NH-1.. 




PEC 


1150 




LN =LN-1,, 




PEC 


1160 




GO TO TELE,. 




PEC 


1170 




END,. 




PEC 


1180 


EXIT.. 






PEC 


1190 


ERROR='P',. 




PEC 


1200 


ENO.. 






PEC 


1210 


END 


*• 


/♦END OF PROCEDURE PEC 


♦ /PEC 


1220 
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Purpose: 

PEC approximates a given polynomial by a poly- 
nomial of lower degree, using a telescoping tech- 
nique, so that the error does not exceed a user- 
specified tolerance TOL. Range of approximation 
is (-a, a) if OPT='0' and (O.a) if OPT='S'. 

Usage: 

CALL PEC (C,N,M,TOL,EPS,A,OPT); 

C(N) - BINARY FLOAT [(53)] 

Given coefficient vector of the p>olynomlal 
P(x) = ci + C2X + . , . . +Cqx'i~-'- 
Resultant coefficient vector of the econo- 
mized polynomial Pm_i (x) = e-j^ + CgX 

N - BINARY FIXED 

Given dimension of given coefficient vector, 

M - BINARY FIXED 

Resultant dimension of economized coef- 
ficient vector. 

TOL - BINARY FLOAT 

Given tolerance specified by the user, 

EPS - BINARY FLOAT 

Resultant bound for the absolute difference 
between the given and economized poly- 
nomial over the specified range. 

A - BINARY FLOAT [(53)] 

Given value defining the range of approxima- 
tion, 

OPT - CHARACTER(l) 

Given option for selection of operation 

Purpose: 

PTC transforms a given polynomial into an expansion 
of Chebyshev pol5aiomials if OPT = '0' and of shifted 
Chebyshev polynomials if OPT = 'S'. 

Usage: 



Given dimension of the coefficient vector, 
A - BINARY FLOAT [(53)] 

Given value defining the range of expansion, 
OPT - CHARACTER (1) 

Given option for selection of operation. 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR = 'P' means invalid parameters: 
either N £ or A = 

A value of OPT different from 'S' is interpreted as 
if it were '0'. 

On return from PEC the locations Cjj^^- , . . . , Cjj 
contain the coefficients of the Chebyshev expansion 
of the difference between the given polynomial P(x) 
and the economized polynomial Pm_i (x): 

P(x) = P (x)+c ^,t (t) + ... c t .(t) 
m-1 m+1 m n n-1 

Therefore, using PEC with a very large tolerance 
TOL (say, 10'^^)has the same effect as the applica- 
tion of PTC. 

Method: 

In the first telescoping step a multiple of the 
Chebyshev polynomial 

*n-l^^^^^ = T (x/a) if OPT = '0' 
T* .^(x/a) if OPT = 'S' 

is subtracted from given P(x), so that the difference 

is a polynomial of degree n-2. 

Set: 



CALL PTC (C, N, A, OPT); 

C(N) - BINARY FLOAT [(53)] 

Given coefficient vector of the polynomial 

P(x) = cj^ + CgX + . . . . + c^x^i"! 

Resultant coefficient vector of Chebyshev 

expansion 

P(X) = Cj + Cg t^ (t) + . . . + c^t^_ J (t) 

with t = x/A 

f T^ it) if OPT='0' 
and tj^ (t) ={t:* (t) if 0PT='S' 

N - BINARY FIXED 



P^_l(x) = P(x) 
then: 

P o(x) = P i(x) - b t , (x/a) 
n-2 n-1 n n-1 ' 



(1) 



Telescoping Pjj.gCx) again results in a polynomial 
Pjj_3(x) of degree n-3, and by iteration 

P(x) = bj + b2t^(x/a) H-bgtg (Va) + , , , +\t^_^ 
(x/a) (2) 
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This means that calciilated b's form the coefficient 
vector of the expansion in terms of Chebyshev 
polynomials. If telescoping steps are performed 
only as long as 



+ b 



n-1 



+ ... + 



m+1 



TOL 



then Pin_i(x) is the economized polynomial. For the 
Chebyshev poljoiomials 



t^(x/a) 



<. 1 for 



^ a 



and for all values of k; therefore, 

P(x) - P ,(x) 
^ ' m-1 



b . ,t (x/a + . . . 
m+1 m 



2 Cq(z)=2 



2 1 C (z)=z -2 



3 1 
2 4 1 C (z)=z^-4z^+2 



5©1 

2(9) 6 1 Cg(z)=z^-6z*+9z^-2 

7 (14) 7 1 

2 16 20 8 1 



C^(z)=z 



Cg(z)=z -3z 



C,(z)=z^-5z^+5z 
5 



+ b 


A-l(-/-) 






<. 


'^m+l 


+ 


^m+2 




+ 


. .. + 


b 
n 


<. TC 


L 



(3) 

Mathematical Background 

Calculation of the coefficients of Tjj(t) 

Set Cj^(z) = 2Tj^ (z/2) or Tj^(t) =|'Cj^(2t), with t=|-. 

(4) 

(5) 

(6) 



Then Cj^ (z) = Sj^(z) - Sj^_2(z) 

.^u <, , X /k\ k /k-l\ k-1 
withSj^(z)=(Jz -( Jz 



+ - ... ± 



C). 



The binomial coefficients ( j are easily generated 
using Pascal's triangle. 

An analogous calculation scheme exists for the 
coefficients of Cj^ (z): 



^ , , k /k\ k k /k-l\ 
V>=k(o)^ - kUl J 



^^^k-2N(^k-4 



k-z 



_k_/k-2\ 
k-2 V 2 / 



(7) 



The coefficients of successive C^ (z) are easily foxmd 
by the calculation scheme 



(8) 

The above calculation scheme means that the first 
column is all two's and the diagonal elements are all 
ones. The remaining elements are obtained by ad- 
ding the two elements above in the same colimm and 
in the adjacent left-hand column. For example, 
circled element 14 is obtained by adding the two 
circled elements 9 and 5. 

The shifted Chebyshev polynomials are reduced to 
ordinary ones using the identity 

2T* (u/4) = 21^^ ( Vi/2) = C^j^ (Yll) (9) 



or 



T* (t) =^C2k^^^^ with t= u/4 



Programming Considerations: 

The triangle (8) may be stored more compactly in the 
rectangular scheme: 



2 13 5 7 

2 4 1 5 14 

2 9 6 17 

2 16 20 8 1 



(10) 
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The coefficients of C21J-1 form subcolumns and those 
of Cgjj corresponding subrows. In order to be able 
to use the coefficients of the auxiliary array (10), the 
given polynomial 



P(x) = c, + c„x + . . . +c x' 
12 n 



n-1 



(11) 



must first be transformed substituting x = i aj t, 
which gives 

P(x) = b^ + bgt + bgt^ + . . . + b^t°~-^ (12) 

By this the argument range gets reduced to the 
standard interval (-1, +1) if OPT = '0' and (0, 1) if 
OPT = 'S'. 

The next step is to introduce z=2t if OPT = '0' and 
u=4t if OPT = 'S' and to divide all coefficients so 



obtained by two, except the first one. Naturally the 
two substitutions may be applied simultaneously: 



X = a 



• t =- 



(13) 



The sequence of calculations performed is as 
follows: 

1. The auxiliary array (10) is set up calculating 
row and column simultaneously. 

2. The given coefficient vector gets replaced by 
the coefficient vector with variable z or u. 

3. In case PTC, performing n-1 successive teles- 
coping steps gives the expansion in terms of Chebyshev 
polynomials. In case PEC, the iterative telescoping 
is stopped as soon as the tolerance TOL is exceeded. 

4. The economized polynomial must be back- 
transformed to the original variable x. 
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PRJCEOUHt PfC ccPNOMIZES A POLYNOJ^IAL USING TRUNCAMON IN CRRRES "HS D ING ChFBYSHFV EXPANSION 
tNTKY PTC TPANSFCBVS A POLYNCflAL TC AN EXPANSION IN TERMS Of CHE8VSHEV PHLYNriMIALS 



HkL;,£DURt PEC 



♦*A2»* 
EMPY 



» « 

» ALLOCATE • 

X* STORAGE FOR * 

• ARRAY T * 



AKf^ FNT.( Y pre* 
INITIALUE * 
tKr<nrt-t(OUNL) * 



«*»* KB ?••*•*»•**• 

* * 

* * 

* MARK E MRY PIC * 
« * 



* PRESET 

* FR»OR=*0' , 
»IN1T. COMP. ( 

* T-ARRAY 



***** 



*********** 



**»**(12«********* 

* I M Tl ALIZE * 

* NORMALIZATI ON * 
X» QF RANGE AND *. 

♦ALLDCATI ON QF T* 

* * 
******t*t*****P** 



* IS A=0 • 

(DEGENERATE 
*. RANGE! .* 



*****Cit********** 

* GENERATE • 

* COEFFIC IFNTS OF* 

* CHFBYSHFV * 

* POLYNOMIALS IN ♦ 

* ARRAY T • 
***************** 



*****ri^********** 

* * 
*NDPMAL IZE RANGE* 
« IN GIVEN * 

• POLYNOMIAL * 
« * 
***************** 



*****t: t,********** 

* * 

* INIT. FIR ST * 

* TFLFSCOPING * 

* STEP * 

* * 
***************** 



*****F t,********** 

* SELECT FRIM T * 

* CnEFFICIENT * 

* VECTOR OF *X. 

* CHESYSHEV * 

* POLYMQHIAL ♦ 
***************** 



**i,*tQ2 ******* 

ft RETURN 

♦JIMENSI ON M 01 

* ECCNOMI ZED 

* PCLYNCMIAL 
************** 



G3 ♦. 
.* WILL ft. 

.•ERROR eCUNfl*. 

. EPS REMAIN .•: 

ft. SUFFIC. .* 

ft. SMALL. ft 



.* 

• YES 



MAS *. 

EVTRY PEC .* 
. USED .* 



Ak^ ILL EGAL * 

AKAMtlERIS). ft 

tRROR^'P' ft 

* 



*»* tH2**ft*ft**ftft 

SUBSTITUTE 
' NORfALI ZEO 

RANGE BACK TO ■■ 
CRIGINAL 



»**«*H3ftftft*ft**ft** 
ft ft 

ft UPD/TE ERROR • 
ft BDUND EPS AND *. 
ft OIMENS ION M ft 



•i*»«[*HAftftftftft*ft*ftft 
ft SUBTRACT ft 

ft MIXTIPLE OF ft 
X* CHEBVSHFV * 
ft POLYNOMIAL • 

* * 

***************** 



END J F 

PidJCEJURt 

PEC/PTC 



.ftFURTHER*. 
ftTELESCOPING* 

STEP 
ft. NEEDED .ft 



*****,(_ I,********** 

* * 
ft INIT. NEXT • 

* TELESCOPING * 
ft STEP ft 
ft ft 
***************** 
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• Subroutine POST 



PCST,, 






POST 


10 


/* 


**************»******»*****t**************»**m***,9*****t»*t****9***/po%r 


20 


/♦ 








♦/POST 


30 


/• 


TRANSFORM 


N-TERf SERIES EKPA^SION IN CRTHOGONAL POLYNOMIALS 


•/POST 


40 


/• 








♦/POST 


50 


/* 






****«*******4*«*a*« ******«***«>*•**«*/ PC ST 


60 




PROCEDURE (XO.X I, CN.CPT, POLL. 




POST 


70 




DECLARE 






POST 


80 




IXO.Xl.CI 


*),PCtl*),F,FI,AI 


.BI,CI,U,Ut,U2,U3,H(N«N}) 


POST 


90 




BINARY FLCAT, 


/♦SINGLE PRECISION VERSION /"SVPOST 


100 


/ 


• BINARY FLCAT153), 


/•DOUBLE PRECISION VERSION /* 


D^/POST 


110 




(Ntl.J.K, 


KPI) BINARY FIXED 




POST 


120 




CPT CHARACTER(l),. 




POST 


130 




IF N GE 1 




/•BYPASS CPERATION IF N LE 


•/POST 


140 




THEN DO,. 




/♦INITIALIZATION 


♦/POST 


150 




AI =XO*XO.. 


/•INIT. CONSTANT MULTIPLIERS 


♦/POST 


160 




CI =X1* 


XI,. 




POST 


170 




IF OPT='T 


• 


/•CHEBYSHEV POLYNOMIALS T(X) 


♦/POST 


180 




THEN BI 


=0.5,. 


/♦MODIFY FIRST CHE6. POLYNOMIALS/POST 


190 




ELSE DO,. 






POST 


200 




BI 


-I,. 


/♦INIT. FIRST ORTH. POLYNOMIAL 


•/POST 


210 




Fl 


=0.. 


/•INIT. INTEGER FACTOR 


♦/POST 


220 




END. 






POST 


230 




KU) =81, 




/♦STORE FIRST ORTH. POLYNOMIAL 


♦/POST 


240 




HID =0t. 




/•INIT. PSEUOO POLYNOMIAL(-l) 


•/POST 


250 




POL(l)=C(l»,. 


/•INIT. RESULTING POLYNOMIAL 


•/POST 


260 




00 I 


= 2 TO N,. 


/♦CALCULATE COEFFICIENT VECTOR 


•/POST 


270 




F 


=c(n,. 


/♦OF I-TH CRTHOGONAL POLYNOM. 


♦/POST 


280 








POST 


290 




THEN 


00,. 


/♦MODIFY MULTIPLIERS AI,BI,CI 


♦/POST 


300 






BI =FI,. 




POST 


310 






FI =FI*1,. 


/•FOR 


♦/POST 


320 






IF CPT NE 'H' 


/•HERMITE POLYNOMIALS H(X) 


♦/POST 


330 






THEN 00,. 




POST 


340 






BI =BI/FI 


. /♦FOR 


•/POST 


350 






IF OPT='L' 


/•LAGUERRE POLYNOMIALS LIXI 


♦/POST 


360 






THEN DC. 




POST 


370 






AI 


l-XO/FUBI,. 


POST 


380 






CI 


-Xl/Fl,. 


POST 


390 






END,. 


/♦FOR 


•/POST 


400 






ELSE DC,. 


/♦LEGENDRE POLYNCHIALS PIX) 


♦/POST 


410 






AI 


<0+BI^XO,. 


POST 


420 






CI 


<l*9I*Xl,. 


POST 


430 






END,. 




POST 


440 






END,. 




POST 


450 






ELSE BI =SI*BI 




POST 


460 






END,. 




POST 


470 




ELSE 


IF I = 3 


/•READJUST CHEBYSHEV POLYNOMIALS/POST 


4ec 




THEN 


HID =1,. 




POST 


490 




U 


=0,. 


/♦INIT. PSEUDC TERM FOR RECURR 


.♦/POST 


500 




K 


= li. 




POST 


510 




KPl 


=2.. 




POST 


520 






DO J = I TO I-l, 


/♦APPLY RECURRENCE RELATION 


♦/POST 


530 






Ul =H(K>,. 




POST 


540 






H(Kt,U2=H(KPl},. 




POST 


550 






IF CPT NE 'T* 


/♦IN CHEBYSHEV CASE 


♦/POST 


560 






THEN 11 =BI*UI 


. /•BYPASS MULTIPLICATION WITH 1 


♦/POST 


570 






H(KP1),U3=AI*U2-UI*CI*U,. 


POST 


580 






U =L2,. 




POST 


590 






P0L(J(=PCL(J)+F*U3,./*UPDATE PCLTNCNIAL VECTOR 


•/POST 


600 






K =KPl*l,. 




POST 


610 






KPl =K+1,. 




POST 


620 






END,. 




POST 


630 




HIK) 


=0,, 


/•INIT. PSEUDO TERM FOR RECURR 


♦/POST 


640 




U3,H(KP1)=U2*CI,. 


/•COMPLETE I-TH ORTH. POLYNOMIALS/POST 


650 




P0HI)=F*U3,. 


/•INIT. I-TH TERM OF POLYNOH! AL^/POST 


660 




END, 




/•COEFFICIENT VECTOR 


•/POST 


670 




END,. 






POST 


680 




END,. 




/•END CF PROCEDURE POST 


•/POST 


690 



Purpose: 

POST transforms a given series expansion in 
orthogonal polynomials to a polynomial. The 
independent variable of the given expansion is as- 
sumed to be xq + xj x; that is, a linear transforma- 
tion of the range is built in. The coefficient vector 
C = (cj, . . . , Cjj) is given. Procedure POST cal- 
culates POL = (poll , . 



pol ) satisfying 



n 

E 

i=l 



c. f. 

1 1- 



(Xq+Xj 



X) 



E P°'i' 



i-1 



1=1 



For the specified set of orthogonal polynomials (fj^) 
the user has the choice of: 



Chebyshev polynomials (Tq, T-^, 
with OPT ='T' 

Legendre polynomials (Pq, P, , 
with OPT = 'P' 



Tn-l) 



Pn-l) 



Laguerre polynomials (Lq, L^, ..., L^_-|^) 

with OPT = 'L' 



Hermite polynomials (Hq, H^^, .. 
with OPT = 'H' 



Usage: 



Hn-l) 



CALL POST (XO, XI, C, N, OPT, POL); 



N 



OPT 



XO - BINARY FLOAT [(53)] 

Given constant term of argument 
transformation, 

XI - BINARY FLOAT [(53)] 

Given linear term of argument trans- 
formation. 

C(N) - BINARY FLOAT [(53)] 

Given coefficient vector of expansion, 

with coefficients ordered from low to 

high. 

BINARY FIXED 

Given dimension of coefficient vector, 

CHARACTER (1) 

Given parameter of choice (see "purpose"). 

POL(N) - BINARY FLOAT [(53)] 

Resultant coefficient vector of resultant 
ordinary polynomial, with coefficients 
ordered from low to high. 

Remarks: 

N must be positive, or operation is bypassed. 

Any input value of OPT other than 'T', 'L', or 
'H' is treated as if it were 'P'. 

Transformation of an expansion in shifted 
Chebyshev or Legendre polynomials is obtained 
using the linear transformation (2xq - 1) + {2x-^) x. 

The resultant vector POL may occupy the same 
storage locations as the given vector C. 

Method: 

The coefficient vector POL is calculated from the 
coefficient vectors of the orthogonal polynomials, 
which are generated successively using the re- 
currence relation. 

with f_^=0, fQ=l. 

For reference see: 

M. Abramowitz/I. A. Stegun, Handbook of Math- 
ematical Functions , Applied Mathematics Series 55, 
National Bureau of Standards , 1964, pp. 771-803. 
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Mathematical Background: 

The coefficient vectors of the orthogonal polynomials 
for argument z = xq +x^ x are generated using the 
three-term recurrence relation: 

Chebyshev polynomials 



T_^ = 0, T^ = 1, T^(z) = x^j+x^x 



• Subroutine PRTC 



Vi <^> 



2XqTj^(z) - \_i(z) + 2x^ . xTj^(z), 



for k a 1 

Legendre polynomials 



P_l = o^Po =1 



Pk-Hl<^)=('-"ili)Vk(^>-(k^)Pk-l<^> 
Laguerre polynomials 



^-1 = «' ^0 = ^ 



x„ 



\-.i<^> =^*ili - i^) S(^> Vk+i/-k-i 



y.iL\ 



(z) 



k^i;XLj^(z), fork.O 



Hermite polynomials 
H-1 = «' % = 1 

Vi = %«k(^>-2'^«k-i<^>^2^i^«k(^>' 

f or k > 

Programming Considerations: 

Using To/2 instead of Tq, the above recurrence 
relation for Chebyshev polynomials is also valid for 
calculation of the coefficient vector of Ti(z) with 
k = 0. The coefficient vectors of two successive 
orthogonal polynomials are combined in an auxiliary 
linear array H with coefficients of the lower poly- 
nomial in H(l), H(3) and those of the higher 

polynomial in H(2), H(4) 

Both coefficient vectors are ordered from low 
to high. 





I KOUNDERFLOM ) . .PRTC . . 


PRTC 10 ] 


/♦♦»*,»»„„.,*,.«*«*,»**#.******»*.*.»..»******»*»*********»«**"«*«/PRTC 20 1 


/• 


♦/PRTC 30 


/♦ CALCULATE ALL RCCTS CF A COMPLEX PCLYKCflAL 


• /PRTC 'tO 


/* 


•/PRTC 50 


/«««******«««**«***«*«*4**«»*«*««*«*«**«***«4*********»*«********«**«*/PRTC 60 I 


PRGCEOURE(CtN}t. 


PRTC 70 


CECLARE 


PRTC 80 


c^*^ COMPLEX 


PRTC 90 


BINARY FLOAT, /'SINGLE PRECISION VERSION 


/•S*/PRTC 100 


/• BINARY FL0AT(53), /•DOUBLE PRECISION VERSION 


/♦D^/PRTC 110 


(0(N»,B(N),Z,02,V,W.U,ZC» COMPLEX 


PRTC 120 


BINARY FLOAT, /*SINGLE PRECISION VERSION 


/•S*/PRTC 130 


/* BINARY FL0AT(53), /•DOUBLE PRECISION VERSION 


/•D^/PRTC 110 


tN.LN,I,K,KOtJ*JE) 


PRTC 150 


BINARY FIXED, 


PRTC 160 


111. IN DEFINED R.ID DEFINED AH , IR. IRl, IR2 1 


PRTC 170 


BINARY fIXEDOl). 


PRTC 180 


(AV,AV0,TCL,A2,Ah,R,R0,RKM,ARG,ARGV) 


PRTC ISC 


BINARY FLOAT, /'SINGLE PRECISION VERSION 


/♦S^/PRTC 200 


/* BINARY FL0AT(53), /•DOUBLE PRECISION VERSION 


/♦0'/P«TC 210 


ERROR EXTERNAL CHARACTER 1 1 ), . 


PRTC 220 


It 3:1091567616, . 


PRTC 230 


LN =N,. /•NUMBER CF MISSING ROOTS 


♦/PRTC 2A0 


Z "=C,. 


PRTC 25C 


ERRCR='0«,. 


PRTC 2eo 


ZERO-. 


PRTC 270 


AVO ='1E75,. /*FORCE SHIFT CF ORIGIN 


♦/PRTC 280 


IF LN LE 


PRTC 2S0 


THEN GO TO EXIT,. /*ALL RCCTS CALCULATED 


•/PRTC 3C0 


IF CILN)=-0 


PRTC 310 


THEN DC. /•EXTRACT ZERO ROOT 


•/PRTC 320 


LN -LN-l,. 


PRTC 330 


GO TO ZERC. 


PRTC 340 


END,. 


PRTC 350 


CZ,2 =CDNJG(Z>.. 


PRTC 360 


DO I ^^ 1 TO LN,. 


PRTC 370 


D(I>,B<II=C(II,. /•MOVE CCEFFICIEN. VECTOR 


♦/PRTC 380 


END.. 


PRTC 3S0 


VALUE.. 


PRTC AGO 


TOL =0.2,. /*IN1T, RCUNO CFF BOUND 


•/PRTC AlO 


AZ =ABSCZ),. 


PRTC *20 


V =1,. 


PRTC A30 


DO I = 1 TO LN,. /*CCMP. RCUND-CFf BOUND 


•/PRTC AAO 


U =DII),, /•AND PCLYNCMIAL VALUE 


•/PRTC A50 


V.C<I)=U+V*Z.. 


PRTC 460 


TOL =-ABS(h)tAZ«TCL.. 


PRTC 470 


END,. 


PRTC 480 


TOL "(T0L»4*nOL-AES(m)) 


PRTC 4<50 


•l.OE-6,.,. /»SINGL£ PRECISION VERSION 


/•S^/PRTC 500 


/• 'CaSE-lS,. /»DOUBLE PRECISION VERSION 


/*D»/PR^C 510 


AV =ABSIV),. 


PRTC 520 


IF AV= THEN GO TC RCOT,, 


PRTC 530 


IF AV LE TOL 


PRTC 540 


THEN If AV GT AVO 


PRTC 550 


THEN DO,. /•STORE CALCULATED ROOT 


•/PRTC 560 


ROOT.. 


PRTC 570 


caN)=z,. 


PRTC 580 


LN -LN-l,. 


PRTC 5S0 


GC TO ZERC. 


PRTC 600 


END,. 


PRTC 610 


ARGV =ATAN(-IHAG(V),-REAL(V)),. 


PRTC 620 


IF AV LT AVO /*HAS VALUE DECREASED 


♦/PRTC 630 


THEN DO.. 


PRTC 64C 


R =AV.. 


PRTC 650 


RCU =1,. 


PRTC 660 


IR "tIN-llI/LN,. 


PRTC 670 


KCJE=LN.. 


PRTC 680 


SHIFT.. 


PRTC 690 


h -1,. 


PRTC 7C0 


DO J-l TC JE,. /*SH1FT CF ORIGIN 


♦/PRTC 710 


SIJ),H=etJI-»t«*OZ,. 


PRTC 720 


END,. 


PRTC 730 


IF LN NE JE 


PRTC 740 


THEN DC. 


PRTC 750 


AH =AflS(HI.. 


PRTC 760 


K =LN-JE,. 


PRTC 770 


IRl =(IN-10>/K.. 


PRTC 780 


IF IRl LT IR 


PRTC 790 


THEN DC. 


PRTC 800 


IR =IR1.. 


PRTC 810 


RO =AN.. 


PRTC 820 


U >h,. 


PRTC 830 


KD >K.. 


PRTC 840 


ENC. 


PRTC 850 


END,. 


PRTC 860 


JE =JE-l,. 


PRTC 870 


IF JE GE 1 


PRTC 880 


THEN GO TC SHIFT,. 


PRTC 890 


RKM =l/FLOAT(KC),. 


PRTC 900 


R =(AV/RD)**RKM,. 


PRTC 910 


ARG >( ARGV-ATAN( IMAG(U), REAL tU}>t •RKM.. 


PRTC 920 


ZO -Z,. 


PRTC 930 


AVO =AV*> 


PRTC 940 


INCR.. 


PRTC 950 


REAL(DZ)<cR*CCS(ARG>,. 


PRTC 960 


IHAG(DZi-R*$Ih(AR6>,. 


PRTC 970 


2 =20+02,. 


PRTC 980 


IF 20 NE Z 


PRTC 990 


THEN GO TO VALUE,. 


PRTCIOOO 


IF AV GT TOL 


PRTCIOIO 


THEN ERROR«'C'.. 


PRTC1020 


GO TO ROOT.. 


PRTC1030 


END,. 


PRTC1040 


ELSE CO,. /♦MODIFY STEPSIZE TO DECREASE */PRTC1050 | 


R =R/2,. /*PCLVNCMIAL VALUE 


♦/PRTC1060 


IR2 =( IN-Ul/ICOOOCOOOOB,. 


PRTC1070 


KC =LN,. 


PRTClOeO 


L =1,. 


PRTC1090 


IR =n/10CCCOCCCCB,. 


PRTCIIOO 


K =0,. 


PRTCIIIO 


DO J = Lh-1 TO I BY -I,. 


PRTC1120 


K =Ktl,.' 


PRTC1130 


W =8(J).. 


PRTC114C 


AH =ABS(h),. 


PRTC 11 50 


IRl =ID/10CC0COC00B-(LN-K)*IR2,. 


PRTC1160 


IF IR LT IRl 


PRTCU70 


THEN DC. 


PRTC1180 


KD =K,. 


PRTCn90 


U =><,. 


PRTC1200 


IR =IR1,. 


PRTC1210 


END,. 


PRTC1220 


END,. 


PRTC1230 
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EXIT.. 

ENCt. 



ARC =(ARGV-«IA^(I«JG(UI,REAL(U1II/FLO«TIKOI 

C-C TO INCR,. 

END.. 



/♦END CF PROCEDURE PRTC 



PR1C1240 
PRTC1250 
PRTC1260 
PRTC1270 
»/PRTC1280 



Purpose: 

PRTC calculates all roots of a given complex 
polynomial. 

Usage: 

CALL PRTC (C, N) . 

C(N) - COMPLEX BINARY FLOAT [(53)] 

Given coefficient vector of normalized 
polynomial 

N N-l 

P(Z)=z'V,Z^ ■^ + ,., +c,, 
1 N 

Resultant N complex roots of given poly- 
nomial. 
N - BINARY FIXED 

Given dimension of coefficient vector. 
N is also the degree of the polynomial and 
the number of roots to be calculated. 



K. Nickel, "Die Nullstellen eines Polynoms", 
Algorithmus 5, Computing , Vol. 2 (1967), iss. 
3, pp. 284-290. 

Mathematical Backgroimd: 

Generalized Newton st ep 

Let Zj be an approximation to a root of 

P(z) =z +c z +.., +c (1) 

1 n 

The next approximation is calcxdated from the co- 
efficients of the shifted polynomial: 

P (z) = b^ (z - z.)'' + b. (z - z.)"""^ 



+ . . . + b with b„ = 1 
n 



z. ^ 1 = z. + 
1 + 1 1 




(2) 



(3) 



where k is chosen so that 



Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected. 



zN 



ERROR='C' means that calculated roots are possibly 
inaccurate. The polynomial must be given in 
normalized form ~ that is, the coefficient of t} 
should be one (and is not stored). The coefficient 
vector is replaced by the calculated roots, begin- 
ning with C(N). The coefficient vector must be 
complex. In the real polynomial case, the imag- 
inary part of the coefficients must be set to zero 
before using PRTC. PRTC will compile with error 
message lEM 11051. However, the generated 
object code executes correctly. 

Method: 

The method used was proposed by K. Nickel. It is 
a generalization of Newton's method and is not 
sensitive to multiple roots. 

For reference see: 

K. Nickel, "Die numerische Berechnung der 
Wurzeln eines Polynoms", Numerische Mathematik, 
vol. 9 (1966), pp. 80-98. 



MN 



j = 0,l, ... n-l 




r, = 



For k = n-l, (3) is the Newton iteration method, 
which requires bj^.j^ / 0, The above iteration 
method works in case of multiple roots. 

Bisection step 

The iteration method (3) does not guarantee 
monotonic convergence. If the condition 



P(^i+l) 



P(z,) 



(5) 



fails for some i, then a new approximation z is 
found such that "^ 



P(z ) 
* m 



P(z,) 



(6) 



The existence of a %j satisfying (6) follows from 

I P(zj) I > and the maximum modulus principle. 
In fact, a suitable Zjj^ can be found in the sequence 



(n-lm) /-b 

z = z. + 2 r, . / 

m 1 k \ / b 

m 




jm 



m = 1, 2, ... 



(7) 
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where 1^^^ is chosen so that 



^m 



(2 r ) m = max 



(2 r^) 






1 1 s j s n-1 (8) 
m-1 •' ^ ' 

The proof of this is given in the first reference 
above. 

Stopping criterion 

The iteration method (3) is terminated if, at some 
step, the poljoiomial value does not decrease and 
the value itself is already less than an estimate of 
the roundoff error. If the estimated roundoff bound 
cannot be met by the polynomial value because of 
failure of the bisection method, the iteration is 
stopped with error indication ERROR='C'. 

Estimate for roimdoff error 

The polynomial value 



P(Z) = y a_ z 



n n-r 

z 
r 



(9) 



r=0 



is evaluated using nested multiplication: 
b_l = 0' \ = %.i = a^ for k 



• • « • u 



0, 1, 2, 
(10) 



;(^"\k>"2.V]/(l-a,_,) 



(11) 



where z = ^ + irj, Q = ra^ + ica, , and ai j^ , ffj |j 
are relative errors of admtion and multiplication 
respectively. 

Solving (10) for aj^ and inserting into 



n n-r 

P(z) = ^ a z 
r=0 



gives 

P(^) - t-n = E ^""^ (o ' 4 + ia 4 
k=0 



- ^^k-l(^,k-'^l,k-*-^,k<^l,k) 
■" ^4-l<'^2,k-^^k^''2,k^l,k) 



^^^\-l(''3,k-'^3.k^\k^3,k) 

^^4-l<\k*^3,k-'''4,k\k» 

(12) 



with P(z) = b . 
n 

Since all arithmetic operations are performed with 
floating point arithmetic ,^ instead of the numbers b , 
internal approximations b will be generated that 
do not satisfy P(z) = b . 

The following calculation will give an estimate of 



P(Z) - b 



The approximate values 

AAA 

b, = rb, + i cb, , 
k — k — k 

A A 

where rb. and cb, are the real and imaginary parts 
of \, satisfy the equations. 

4=[^'4-i(i"\k>-^4-i(^^''2,k>] 



With a 



i.k 



sa, 



\kM'^'ri,k(^^^i,k)r''' 



and b - = 



P(2) -b 



n-1 

-E 
k=l 



n-k 



k-1 



(CT+37r) + o 



(13) 



or 



P(z) - b 



n-1 



^ E 


z 


n-k 


A 


(2 cr + 3 TT) 




k=l 


1 "^1 




/I 






n 


1 








f a 


y\ 




z 


+ 


b 

nl 



= E 
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E may be generated using the iteration scheme 



Programming Considerations: 



e„ = 



2c7 + 3ir 



\ '\=\* ^ 



\-l for 



k = 1, 2, ... , n 



giving 



E = (2a + 3 7T) e - (a + 3 ff) 



In single precision, ct = ff = 10~® . 

In double precision, a = it = 0.25 • 10" ■'•^. 



(14) 



The polynomial must be givai in normalized form; 
that is, the coefficient of z^ must be unity. Co- 
efficients are ordered in decreasing order. 
Calculated zeros replace the coefficient vector; 
that is, the root stored in C(n) is calculated first 
and the root stored in C(l) is calculated last. 

The iteration scheme starts with z = initially. 

As soon as the root Zj has been calculated, P(z) 
is divided by z - z^, giving Pi(z). The complex 
conjugate z^ is used as the initial guess for a root 
of P]^(z). Finally Zq is obtained as the root of 
Pii_l(z), a linear pol5momiaI. 

No attempt is made to refine the approximated 
zeros with the original coefficient vector. 
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PROCfcOURF PHTC CALCULATES ALL RTCIS OF A Cd^PLfcX PntY'^'TIUL 



•HKJCbJURc PRIC 



•COMPLIE CCMPLEX* 

* INCREMENT nZ *X 

* ANR NEW Z * 



• INCREMfNT 

NEGLIGIBLV 
♦. SVALL . 



«*»***«**«*«*»*«* 



**«** CI ********** 



«*****«******«* 



* * 
♦FUKCt SHIFT OF ♦ 
*UKHiIN TO TAKE •X. 

* PLACE • 

* * 
*t.*r ****** ******* 



************* 



*****n2********** 

* * 

* SAVE FACTORED ♦ 
.* BOnT, UPPATF *X. 

* RCCT COUNT * 

* * 
***************** 



*****^2 ********** 



.*ARE ALL*. 
• ROOTS 
LALCULATEO 



•»*»G1********* 
* tND OF * 

*PRUCcOUft£ PRTC * 
« 4 



• * Kuu I ■ urua ic * 

* ROOT COUNT * 

* * 
****tt*********** 



.* HAS *. 

. * CURRENT *. 
.X*. FACTOR ZERO . * 
*. RCCT .* 



«*«**G2 ********** 

•CONJUGATE FIRST* 
*GUE SS Z. I NIT. * 
• INCREMENT DZ = Z * 



HCVE • 

COEFFICIFNT * 

VFC TOR C TC B * 

ANO D • 

♦ 

**************** 



c 


VALUF 

*****riTi*********« 

• CCMP. ROJNO-OFF' 

* BCUND TOL ANC * 


.*. 

fl'i *. 

.* IS *. 

.« FUNCTinN *. NO 






• DEFLATF 

* IN 


■} VFCTOR* 
C * 


*. zFftn .* 
• . .* 

*. .* 

• Y= S 












X 










C5 «. 
. * I S V *. 
YES . *AflSOLUTELy *. 






». TOL .• 

■ •* NO I 




: 




X 
.*, 

n4 *. 

.* HAS *. 

NO .* FUNCTION *. YES 


*X ', 

* CHMPUTF • '. 

* ARGUMENT CF • 
...X*FUNCTinN VALUE « 

* * ' 








• .DEOEASFO.* 

**. .*' 

• 








SHIFT 

*****F'^********* 

* PERFORM SHIFT * 

* BY DZ, ST'iRE * 
•COFFFICIFNTS IN«X... 

* * 


X C 

F ^ * * •. 
. * HAS ». 
YES .* FUNCTION *. 
....*. VALUF .* 
*.nFCREASFn.» 
*. . » 
*. . * 
* NO 








X 
*****fet***«****** 

* COHP. INDEX • 
•WHICH MINIMIZES* 

• R{K ) (EQUATION * 

• A) • 

* « 


X * 

* • I 

•HALVE PREVICUS • 

* MOf^ULUS OF * 

* INCREMENT • 








X 
*****(^i,*t******** 

* SAVF GUESS Z * 
« ANH A9S0LUTF « 
*FUNCTinN VALUF ♦ 
« * 
«-*%»t« *********** 


X 
««***GS •*•«••«•«• 

* S^LFCT * 

* CnFFFICIFNT « 

* MI TH MAXI MAL * 

* C0NTRI8UTI CN ♦ 

* lEOUATI ON 61 * 








X 
^tr**iH^^********** 

• CniPUTF MHOIILUS* 

• Of NEXT • 

• INCFMFNT » 

^^it* ******** ****i, 


X '. 

* COMPUTE • 

• ARGUMENT CF *... 
*NFXT I NCRFMENT • X 














X 
*t***J i,**«******* 

* COMPUTE * 

• APGUMENT OF •. . . . 





>JEXT INCRFMFNT 
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Numerical Quadrature 
Quadrature of Tabulated Functions 
• Subroutine QTFG/QTFE 



QTFG.. 


QTFG 


10 




•**•*/ QTFG 


20 


/• 


*/OTFG 


30 


/• IhrEGRATION CF A KCNOTONICALLY TABUIATEO FUNCTION BY 


*/OTFG 


40 


/* TRAPEZOIDAL RULE 


♦/QTFG 


50 


/» 


♦/QTFG 


60 


/*,**«*»**,«„**«»»,»,*»»*,,,*t»,*»,„„„*„»*„,„„,,„„,,»4,,,,^^Q^pg 


70 


PRaCEOURE(X,Y.Z.0IH),. 


QTFG 


80 


CECLARE 


QTFG 


90 


(XI*l,Y(«),2(*)tSUM,XC»XN»Y0.YN,H,HHt 


QTFG 


100 


BINARY FLOAT, /•SINGLE PRECISION VERSION 


/♦S^/QTFG 


110 


/• BINARY fLCAT(53l, /*DOUBLE PRECISION VERSION 


/•O^/QTFG 


120 


<OIM,n BINARY FIXED. 


QTFG 


130 


(ERROR EXTERN AL,SV«)CHARACTEfitl),. 


QTFG 


140 


SN ='I'.. 


QTFG 


150 


XO =X(1),. 


QTFG 


160 


GOTO COli,. 


QTFG 


170 


QIFE.. 


QTFG 


180 


/,*,,♦« *»,**»«*,«,„,*,»«,»„,„,«,,»«,«,»,,,,»,„,,^,,»,,,,^,„,,,,„^^Q^Pg 


190 


/• 


♦/QTFG 


200 


/• INTEGRATION CF AN EOLIDISTANTLY TABULATED FUNCTION BY 


•/QTFG 


21C 


/• TftAPEZOIOAL RULE 


♦/QTFG 


220 


/* 


♦/QTFG 


230 


/•*.».,*,*»»**,,*«»,,»»«*,.,#,,»,,„»«,„„„„,„.„«,„„,»„,„^^„^Q^pg 


240 


ENIRY1H,Y,Z,D1MI,. 


QTFG 


2 50 


Sh ='0',. 


QTFG 


260 


HH =0.5«H,. 


QTFG 


270 


CCM.. 


QTFG 


280 


ERRORS' I'.. /*PRESET ERROR PARAMETER 


♦/QTFG 


290 




1 ♦/QTFG 


300 




QTFG 


310 


ERRCR=*0',. 


OTFG 


320 


SUH =0,. 


QTFG 


330 


YO =-Yll),. 


QTFG 


340 


DO 1=1 TC CIK,. 


QTFG 


350 


IF Sh='l' 


QTFG 


360 


THEN DO,. /♦CALCULATE LENGTH OF INTERVAL */QTFG 


370 


XN =XiI),. 


QTFG 


380 


HH =C.5*(XN-X0),. 


QTFG 


390 




OTFG 


400 




QTFG 


410 


¥N =V(I),. 


QTFG 


420 


SUM =SUK+hH*(YN*YC»,, /*ACCUHULATE INTEGRAL VALUE 


♦/OTFG 


430 


ui) =sur>,. 


QTFG 


440 


YO =VK,. 


QTFG 


450 


END,. 


QTFG 


460 


END,. 


QTFG 


470 


END,. /tEND Cf PROCEDURE QTFG 


♦/QTFG 


480 



Purpose: 

QTFG computes a vector Z of integral values for a 
given vector X of argument values and a given vector 
Y of function values. 

Usage: 

CALL QTFG (X, Y, Z, DIM); 

X(DIM) - BINARY FLOAT [(53)J 

Given vector of argument values. 
Y(DIM) - BINARY FLOAT [(53)] 

Given vector of function values. 
Z(DIM) - BINARY FLOAT [(53)] 

Resultant vector of integral values. 
DIM - BINARY FIXED 

Given dimension of vectors X, Y, Z. 

Purpose: 

QTFE computes a vector Z of integral values for a 
given vector X of equidistantly tabulated argument 
values and a given vector Y of function values. 



Usage: 

CALL QTFE (H, Y, Z, DIM); 

H - BINARY FLOAT [(53)] 

Given difference of two successive 
arguments: 

Y(DIM) - BINARY FLOAT [(53)] 

Given vector of function values. 

Z(DIM) - BINARY FLOAT [(53)] 

Resultant vector of integral values. 

DIM - BINARY FIXED 

Given dimension of vectors Y, Z. 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error condition 
that may be detected: 

ERROR='l' - means DIM is less than 1. 
The vectors Z and Y may be identically allocated, 
which means that the given function values are re- 
placed by the resultant integral values. 

Method: 

The integral values are obtained by means of the 
trapezoidal rule. 

For reference see: 

F. B. Hildebrand, Introduction to Numerical 
Analysis, McGraw-Hill, New York- Toronto- London, 
1956, pp. 75. 

Mathematical Background: 

Let Xj, yj be the given table of arguments and func- 
tion values. 

The vector of integral values 

.X. 



.=/' 



y(x) dx 



is calculated using the trapezoidal rule 

Z. = z. , +(ll^)(y +y J 

1 1-1 2 "^i -^i-r 

for i = 2, . . . , DIM 
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with z^ = 0, 

la case of equidistant arguments: xi - x^_i = h. 

The local truncation error at each step is 

^1- lT<^i-v/y"<?i^'(^i^Pi'Vi]) 

assuming that y(x) has continuous derivatives up to 
the second order. 

The total tmmcation error is the accumulation of 
the local errors at the previous step. 



• Subroutine QSF 



«••*««•*•*«*««««•*«*•«*•»«*«*****«••*•* 



INTEGRATION CF AK ECUIDI STANTLY TABULATED FUNCTION BY 
SIMPSON'S RULE 



PROC EDUR E(H,Y.ZtDIP')T. 
DECLARE 

(h.YMltZt*) tAUX,SUfl.SUM2,HH, 
BINARY FLOAT, 
* eiNARY FLOAT(53> . 

ERROR EXTERNAL CHARACTER! 1 1 » 
(I, DIM) BINARY FIXED.. 
ERRGR='l',. 
IF CIM GE 4 
THEN DO,. 

ERRCR='0' ,. 
HH =H/3,. 
Fl =YC1),. 
F2 =Y(2),. 
SU«1,Z(1)=0,. 
SUM2,Z(2)=HH*0.I25*19»F1+ 
19»F2-5*Y(3)*V(4)),. 
DO 1=3 TG DIM,. 
AUX =F2»F2,. 

=AL>*AljX*Flt. 
=F2,. 
=Y(I),. 

=HH«(AIX*F2I ,. 
SUMl =SUK1*ALX,. 
AUX,Z(I) = SU>'l,. 
SUMI =SUf2,. 
SUM2 =AUX,. 
END, . 
ENOt. 
ENOr. 



AUX 
Fl 



AUX 



it************** 



F1,F2I 

/♦SINGLE PRECISION VERSION 

/•DOUBLE PRECISION VERSION 



/♦PRESET ERROR PARAMETER 
/*N0 ACTION IN CASE DIM LT 



/♦COMPUTE Z12J BY COMBINATION 
/♦OF SIfPSCN'S WITH 3/8-RULE 



/♦ACCUf^ULATE INTEGRAL VALUE 



/♦ENO CF PROCEDURE OSF 



QSF 


10 


♦♦/OSF 


20 


♦ /OSF 


30 


*/OSF 


40 


*/QSF 


50 


*/OSF 


60 


♦♦/OSF 


70 


QSF 


60 


OSF 


90 


QSF 


ICO 


S*/OSF 


110 


D^/QSF 


120 


QSF 


130 


OSF 


I'.O 


♦ /QSF 


150 


♦ /OSF 


160 


QSF 


170 


QSF 


180 


OSF 


190 


OSF 


200 


QSF 


210 


QSF 


220 


♦ /QSF 


230 


♦ /OSF 


2A0 


QSF 


250 


QSF 


260 


QSF 


270 


QSF 


280 


QSF 


290 


QSF 


300 


♦ /QSF 


310 


QSF 


320 


QSF 


330 


QSF 


310 


OSF 


350 


QSF 


360 


♦ /QSF 


370 



Purpose: 

QSF computes a vector Z of integral values, given 
a vector Y of function values corresponding to a 
vector X of equidistantly tabulated arguments. 

Usage: 

CALL QSF (H, Y, Z, DIM); 

H - BINARY FLOAT [(53)3 

Given difference of two successive 
arguments: 

H=xi-xj_i 
Y(DIM) - BINARY FLOAT C(53)] 

Given vector of function values. 
Z(DIM) - BINARY FLOAT [(53)] 

Resultant vector of integral values. 
DIM - BINARY FIXED 

Given dimension of vectors Y and Z. 

REMARKS: 

If no errors are detected in the processing of data, the 
error indicator, ERROR, is set to zero. The follow- 
ing constitutes the possible error condition that may 
be detected: 

ERROR='l' - means DIM is less than four. 

Vectors Y and Z may be identically 
allocated, which means that the given 
function values are replaced by the 
resxiltant integral values. 

Method: 

The integral values Zj are obtained by Simpson's rule 
together with Newton's 3/8 rule. 
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For refereace see: 



• Subroutine QHFG/QHSG/QHFE/QHSE 



F. B. Hildebraud, Introduction to Numerical Anal- 
ysis , McGraw-mU, New York- Toronto- London, 
1956, pp. 71-76. 

R. Zurmiihl, Praktische Mathematik fiir Ingenleure 
und Physiker . Springer, Berlin/Gottingen/ 
Heidelberg, 1963, pp. 214-221. 

Mathematical Background: 

Let Y = (yj, yg, . . . , Yjyj]^) be the given vector of 
function values corresponding to equidistant 
arguments Xj. 

The vector of integral values 
«x. 



. =/ ' 



y(x) dx 



is calculated from Simpson's rule 

■u 

^i = ^-2 ''T^i-2 "" ^^i-l + yj) for i = 3 DIM 

(1) 

where the value of z^ is obtained using a combination 
of Simpson's rule and Newton's 3/8 rule 

z. = ^i_s^3/8hiy._^+3y._^ + 3y._^+y.) (2) 
resulting in 



h =^i+^<9yi + i%-5y3+y4) 



(3) 



with zi = 0. 



The local truncation errors of the above formulas 



are: 



R, . =^h%<^^Ci), ^Ux._2, X.]) 



R_ 



l,i 90 

Xi ^^'^^"^ (V. (^i^^V3'-i^> 
However, these truncation errors may accimiulate* 



/•*«••««*•«*«*«**«*«,««*«,,«,,„„ 



>•*«*••*«*«*« 



OHFG 
»«****/QHFG 

INTEGRATICN CF A »«CN0T0N1CALLV TA6ULATEC FUNCTICN WITH s/OhFG 
FIRST DERIVATIVE BY A HERMITIAN FORMULA OF FIRST CRDER */CHFG 

•/OHFG 



•******/OhFG 



OHFG 



PROCEOUREIX.V,FOY,Z,CIf<), 
DECLARE 

(X(*),Y(*J,21*),fO¥l*),SDY(«l,XC,XN,YC,YN,FOYO,FDVN,SDYO,SDYN, cl-FG ICC 
SUH1,SUM2,FACT,H,HH,HHH» 
BINARY FLGAT, 
• BINARY FL0AT(53) , 

( l.OIK) BINARY FIXED. 

(ERROR EXTERNAL, St.)CHARACTERCl) 



/*SIhGLE PRECISION VERSION 
/♦DOUBLE PRECISION VERSION 



GOTO fCNO,. 
QHSG.. 



»*4««^« 



«•«** 



INTEGRATION OF A HCNCTONIC ALLY 

FIRST AND SECCND DERIVATIVES BY A HERCITIAN FORMULA 01= 

SECOND ORDER 



•«44*»** 



«**««**« 



,DIf), 



QHFG 110 
/•S*/Of.FG 12C 
/•0*/QHFG 130 
QHFG UO 
OHFG 150 
OHFG 160 
QHFG 170 
OHFG 180 

•/QHFG 200 
ABULATEC FUNCTION WITH •/QHFG 210 
«=/QHFG 220 
*/QHFG 230 
•/QHFG 240 
♦♦**»«*4*****»„/Cf.fg 250 

QHFG 260 

OHFG 27C 

QHFG 260 

QHFG 290 

OHFG 3C0 

OHFG 310 

*•»********«***/ Qt^fQ 320 

i!^I!9'**Zi9^.9f ?^ ECLIDISTANTLY TABULATED FUNCTION hITH •/QHFG 3^0 

*/QHFG 350 
*/Ot-FG 360 

OHFG 380 
OHFG 

OHFG 400 

QHFG 410 

•*•••*••*••••*♦•••**** •*****«/QHFG a 20 

INTEGRATICN CF AN ECLIDISTANTLY TABULATED FUNCTICN WITH 
FIRST AND SECCND DERIVATIVES BY A HERCITIAN FORMULA OF 
SECOND CRDER 



/4*4««*t.*«*«»«4444«« 

ENTRY(X,Y,FDY,SDY 
S*. ='2',. 

MONO.. 

XC =XU),. 

GOTO ^-ONEO,. 
OFFE.. 

/««**t*«*«4«444««44,, 
/* 



««*•««« 



*«*««*» 



FIRST DERIVATIVE BY A HERMITIAN FORMULA OF FIRST ORDER 



/«****4«*«*«4«4«4«4«4«44,, 

EN1RV{H,Y,FDY,2,0II'),. 
Sh =»3',. 

GGTC ECUI,. 

OHSE.. 

/444*«*4*4««*«*4*4***44**4< 



(44«*4*** 



••***•«•* 



«44**«4 4 444*«*«4**»*4 44t«**4 

ENTRY(H,Y,F0Y,SDY,2,DIf ),. 
Sh =M',. 



4*«**444«**4: 



/•PRESET ERROR PARAMETER 
/♦NO ACTION IN CASE DIM LT 



EOUI.. 

Hh =C.54H,. 
MONEQ.. 

ERRCR='l',, 

FACT -:3.333333333333333E-0l, 

IF DIM GT 

THEN CO,. 

ERRGR=*0',. 
IF SW NE 'l* 
THEN 00». 

IF SM NE 'S* 
THEN DO,. 

FACT =0.4,. 
SOYC =-SOY(ll.. 
END.. 
END,. 
YO =-Y(l),. 
FDYO =FD¥(1),. 
SUMl,SUM2=0,. 

00 1=1 TC DIM,. 
YN =Y(I),. 
FOYN =FDy(II,. 
IF Sh NE '3' 
THEN 00,. 

IF Sh NE '4' /♦SW =•!• OR SW 

THEN DC,. /*FOR KONECUICIST ANT ARGUMENTS ♦/QHfG 760 

XN =X(n,. /♦COMPUTE LENGTH OF INTERVAL •/QHFG 770 
hH =0.54(XN-X0) 
XO =XN,. 
END,. 
IF Sh NE '1' 
THEN DC,. 

SDYN =SOYCI), 
SUf2 =HH«HH4 
1S0YC+ 
SDYM/15 
SDYO =SOYN,. 
ENC. 
ENC. 
HHH =HH4FACT,. 
SUMl =SUM1+HH#(YC+YN* /♦ACCUMULATE INTEGRAL VALUE 

HHH^(FCY0-FDYN(*SUM2»,. 
ZUl =SLMl,. 
YO =YN,. 
FOYO =FDYN,. 
END,. 
ENOt . 
END,. /♦END CF PROCEDURE OHFG 



♦/OHFG 440 

•/OHFG 450 

♦/QHFG 460 

*/QHFG 470 

♦•/OHFG 48C 

OHFG 490 

QHFG 500 

OHFG 510 

OHFG 520 

QHFG 530 

*/OHFG 540 

OHFG 550 

♦/OHFG 560 

QHFG 570 

OHFG 560 

QHFG 590 

QHFG 600 

QHFG 610 

OHFG 620 

QHFG 630 

QHFG 640 

QHFG 650 

QHFG 660, 

QHFG 670 

OHFG 680 

QHFG 690 

QHFG 700 

OHFG 710 

OHFG 720 

QHFG 730 

QHFG 740 

♦/OHFG 750 



/*SW 



CR SH ='4' 



/♦MODIFY TC SECOND ORDER 
/♦FORMULA 



QHFG 780 
QHFG 790 
QHFG 600 

♦/QHFG 810 
QHFG 820 
OHFG 830 

♦/OHFG 840 

♦/QHFG 850 
QHFG 860 
OHFG 870 
OHFG 880 
OHFG 890 
QHFG 900 

*/QHFG 910 
QHFG 920 
QHFG 930 
QHFG 940 
QHFG 950 
QHFG 960 
QHFG 970 

♦/OHFG 980 



Purpose: 

QHFG computes a vector Z of integral values for 
given vectors X, Y, and FDY of argument, function, 
and first derivative values respectively. 

Usage: 

CALL QHFG (X, Y, FDY, Z, DIM); 
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X(DIM) - BINARY FLOAT [(53)] 

Given vector of argument values. 
Y(DIM) - BINARY FLOAT [(53)] 

Given vector of function values. 
FDY(DIM) - BINARY FLOAT [(53)] 

Given vector of first derivative values. 
Z(DIM) - BINARY FLOAT [(53)] 

Resultant vector of integral values. 
DIM - Given dimension of vectors X, Y, 

FDY, Z. 



DIM 



Purpose: 



BINARY FIXED 

Given dimensions of vectors Y, FDY, Z. 



QHSE computes a vector Z of integral values for 
given vectors Y, FDY, SDY of function values, 
first derivative values, and second derivative 
values respectively, corresponding to a vector 
X of equidistantly tabulated arguments. 



Purpose: 

QHSG computes a vector Z of integral values for 
given vectors X, Y, FDY, and SDY of argument, 
function, first derivative, and second derivative 
values respectively. 

Usage: 

CALL QHSG (X, Y, FDY, SDY, Z, DIM); 



X(DIM) - 
Y(DIM) - 
FDY(DIM) 
SDY(DIM) 

Z(DIM) - 
DIM - 

Purpose: 



BINARY FLOAT [(53)] 

Given vector of arguments. 

BINARY FLOAT [(53)] 

Given vector of function values. 

BINARY FLOAT [(53)] 

Given vector of first derivative values. 

BINARY FLOAT [(53)] 

Given vector of second derivative 

values. 

BINARY FLOAT [(53)] 

Resultant vector of integral values. 

BINARY FIXED 

Given dimension of vectors X, Y, FDY, 

SDY, Z. 



Usage: 

CALL QHSE (H, Y, FDY, SDY, Z, DIM); 

H - BINARY FLOAT [(53)] 

Given difference of two argument 

values: H = ^i " ^i-1 
Y(DIM) - BINARY FLOAT [(53)] 

Given vector of function values. 
FDY(DIM) - BINARY FLOAT [(53)] 

Given vector of first derivative values. 
SDY(DIM) - BINARY FLOAT [(53)] 

Given vector of second derivative 

values. 
Z(DIM) - BINARY FLOAT [(53) ] 

Resultant vector of integral values. 
DIM - BINARY FIXED 

Given dimensions of vectors Y, FDY, 

SDY, Z. 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
foUowii^ constitutes the possible error condition 
that may be detected: 
ERROR ='1' means DIM is less than 1. 



QHFE computes a vector Z of integral values for 
given vectors Y and FDY of function and first 
derivative values respectively, corresponding to a 
vector X of equidistantly tabulated argument values. 



The storage allocation of vector Z may be identical 
to one of the given vectors, which means that the 
given values are replaced by the resultant integral 
values. 



Usage: 



CALL QHFE (H, Y, FDY, Z, DIM); 



H - 

Y(DIM) - 
FDY(DIM) 
Z(DIM) - 



BINARY FLOAT [(53)] 

Given difference of two arguments: 

H= x.-Xi_i 

BINARY FLOAT [(53)] 

Given vector of function values. 

BINARY FLOAT [(53)] 

Given vector of first derivative values. 

BINARY FLOAT [(53)] 

Resultant vector of integral values. 



Method: 

The calculation of integral values is done using 
Hermitian formulas of the first and second order. 

For reference see: 

F.B. Hildebrand, Introduction to Numerical 
Analysis , McGraw-Hill, New York-Toronto- 
London, 1956, pp. 314-319. 

R. Zurmuhl, Praktische Mathematik fur 
Ingenieure und Physiker. Springer, Berlin/ 
Gottingen/Heidelberg, 1963, pp. 227-230. 
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Mathematical Background: 

Let X, Y, FDY, SDY denote the vectors of argu- 
ments Xi, function values y^, first derivative values 
Yi' and second derivative values yj" respectively. 

The vector of integral values 



-f 



z. = / y(x) dx 

'x^ 



is calculated from one of the following: 
Hermitian formula of first order: 



z. = z. , + 
1 1-1 



i 1-1 



[^i-1 ■" h 



X. - X. 



L_J± (y'i-i-y'i)] 

6 



with z = 0. 



(i = 2,3, ..., DIM) 
Hermitian formula of second order: 



X. - X / 

z. = z + ) V + y 

11-1 o ) ^i-1 i 



X. - X. , 

1 1-1 



[^i-l' - ^i' 



12 ^-^i-l -^i 



(i =2,3, ..., DIM) 



with z = 0. 



(1) 



(2) 



Corresponding formulas for equidistant argu- 
ments (meaning x - x - h): 
1 i-1 



11 r 

Z. = Z. . + — - y + V 

1 i-1 2 L i-1 i 



(la) 



-^i^^-i-^)] 

(i=2,3, ..., DIM) 



with z = 0, and 



.-^iv... 



z. = z. , + — -— / V + V 
1 i-1 2 Vi-1 •'^i 



(lia) 



+ ^ fy. , -y' +— (y" 
5 L"^ i-1 -^ i 12 ^-^ i-1 

+ y.")] i (i=2,3 DIM) 



with z = 0. 

Assuming that y(x) has continuous derivatives up 
to the sixth order, the local truncation error at 
each step is 



H = ^'^"'i-1^ J4) 
l,i 



120 



r ' (Cp 



(^ 



i ^ [-i-i- -i] ) 



and 



(x. - X. ,) 
100800 

(^i ^ [\.r xj ) 

The total truncation error is the accumulation of 
the local errors at the previous step. 

For equidistant arguments, this leads to: 



(I e [x^. xj ) 



and 



1 , 6 (6) 

^2n= -100800 ^ y <a 

(4 e [x^, x^] ) 

where 1 is the length of the integration interval. 
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Quadrature of Nontabulated Functions 
• Subroutine QATR 



QATR 
*«**«*******« 4 1»***«****4-4******** •««***«*****«*•«««************/ QATR 

♦/QATR 
INTEGRATICK CF A GIVEN FUNCTION BY THE TRAPEZOIDAL RULE */QATR 
TOGETHER hITH RCMSERG'S EXTRAPOLATION METHOD */QATR 

*/OATR 



PROCEDURE 


{XL,XU,£PS,01M,FCT,Y),. 






QATR 80 


DECLARE 








QATR 90 


(XL.XUrEPS,Y,AL)X(DlM),H,HH,E, 


fy. 




QATR 100 


DELT1,DELT2,P,HD,X,SV,Q,AN,A01 




QATR 110 


BINARY FLOAT, 


/•SINGLE 


PRECISION VERSION 


/•S#/QATR 120 


/* BINARY FLCAT153>, 


/♦DOUBLE 


PRECISION VERSION 


/♦0*/QATR 130 


ERROR EXTERNAL CHARACTER ( 1 » , 






QATR lAO 


(DIM 


JJ,I,J) BINARY FIXED, 






QflTR 150 


FCT 


MIRY 






QATR 160 


(BINARY FLCAT» 


/♦SINGLE 


PRECISION VERSION 


/•S^/QATR 170 


/« (BINARY FL0ATt53)) 


/♦DOUBLE 


PRECISION VERSION 


/♦D*/OATR 180 


RETURNS(BINARY FLOAT),. 


/•SINGLE 


PRECISION VERSION 


/♦S^/QATR 190 


/♦ RETURNSIBINARY FLCAT(53n.. 


/•DOUBLE 


PRECISION VERSION 


/•D*/QATR 200 


AN,YY,AUX( n=0.5*(FCT(XLH-FCT(XU)) 






QATR 210 


H =XU- 


XL,. 






QATR 220 


ERR0R='O' 




/♦PRESET 


ERROR PARAMETER 


•/QATR 230 


IF EIC GT 


1 






QATR 2A0 


THEN DC. 








QATR 250 


IF H 


=0 






QATR 260 


THEN 


GOTO YEND,. 






QATR 270 


hH 


=H,. 


/♦NORMAL 


CASEtDIM GREATER THAN ♦/QATR 280 | 


E 


=ABS(EPS/H),. 


/•I AND 


Kl NOT EQUAL TO XU 


•/QATR 290 


DELT2=0,. 






QATR 300 


P 


= 1 ,. 






QATR 310 


JJ 


= 1,. 

DO 1=2 TC CIK,. 
0ELTI=DELT2,. 

HD =HH,. 
HH =0.5*HH,. 
P =0.5*P,. 
X =XL+HH,. 
SM =0,. 






QATR 320 
QATR 330 
QATR 340 
QATR 350 
QATR 360 
QATR 370 
QATR 380 
QATR 390 




DO J=l TO JJ,. 


/•REFINE 


STEPSIZE IN 


•/QATR 400 




SM =SM+FCTIX»,. 


/•TRAPEZOIDAL RULE 


•/QATR 410 




X =X*HO,. 






QATR 420 




END,. 






QATR 430 




AN,A0,AUX(I)=0.5«ANtP*S>' 


,. 




QATR 440 




=1.. 


/♦APPLY 


ROMBERG'S EXTR APOLATION^/QATR 450 | 




DO J=l TO I-l,. 


/•HETHCD 




•/QATR 460 




Q ='i*Q,. 






QATR 470 




Aa,AUX(I-J)=AC*(AO- 


AUX(I-J))/tO-l),. 


QATR 480 




END,. 






QAIR 490 




DELT2=ABS(YY-A0»,. 


/♦TEST ACCURACY 


•/QATR 500 




IF I GE 5 






QATR 510 




THEN 00,. 






QATR 520 




IF 0ELT2 GE DELTl 






QATR 530 




THEN DC,. 


/•TERMINATE SINCE LAST STEF 


•/OATR 540 




IF DELTl GT E 


/♦DID NOT IMPROVE 


♦/QATR 550 




THEN ERRCR='l 


,, 




QATR 560 




GOTO YEND,. 






QATR 570 




END,. 






QATR 580 




YY =AC,. 






QATR 590 




IF CELT2 IE E 






OATR 600 




THEN GOTO YENO,. 






OATR 61C 




END,. 






QATR 620 




ELSE YY =A0.. 






QATR 630 




JJ =JJ+JJ,. 






QATR 640 




END,. 






OATR 650 


END 


. 






QATR 660 


ERR0R='2 


,. 






QATR 67C 


YENO.. 








QATR 680 


Y =H*YY,. 






QATR 690 


ENC.. 




/♦END CF 


PROCEDURE QATR 


•/QATR 700 



Purpose: 

QATR computes the integral value 
•XU 



•'XL 



FCT(X) dX 



for a given function FCT(X), defined in the closed 
interval [XL, XU], by the trapezoidal rule 
together with Romberg's extrapolation method. 

Usage: 

CALL QATR (XL, XU, EPS, DM, FCT, Y); 

XL - BINARY FLOAT [(53)] 

Given lower bound of the interval • 



XU - 

EPS - 

DIM - 
FCT - 



BINARY FLOAT [(53)] 
Given upper bound of the interval. 
BINARY FLOAT [(53)] 
Given upper bound of the absolute 
error. 

BINARY FIXED 

Given maximum number of extrapola- 
tion steps + 1 (for details see 
"Programming Considerations"), 
ENTRY 

Given procedure for calculation of the 
function values, which must be sup- 
plied by the user. 

Usage: 

FCT(T) 

T - BINARY FLOAT [(53)] 

Given argument. 
FCT(T) - BINARY FLOAT [(53)] 

Resultant function value. 
BINARY FLOAT [(53)] 
Resultant approximation for the 
integral value. 



Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR = '1' means that it is impossible to reach 
the required accuracy because of 
rounding errors. 

ERROR = '2' means that it was impossible to check 
accuracy because DIM is less than 5 , 
or the required accuracy could not be 
reached within DIM-1 steps. 

Method: 

Evaluation of the approximation Y to the integral 
value is done by means of the trapezoidal rule 
combined with Romberg's extrapolation method. 

For reference see: 

S. Filippi, "Das Verfahren von Romberg-Stiefel- 
Bauer als Spezialfall des allgemeinen Prinzips 
von Richardson" , Mathematik-Technik - 
Wirtschaft . vol. 11, iss. 2(1964), pp. 49-54. 

Bauer, Algorithm 60, CACM, vol. 4, 155.6 
(1961), pp. 255. 
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Mathematical Background: 

The problem Is to compute an approximation for 

b 
y = I f (x) dx (1) 



/ 



Successively dividing the interval [a,b] 
into 21 equidistant subintervals (i = 0,1,2,,..) 
and using the following notations: 

, b-a 

h. = — T- ; X = a + k • h., 
1 2^ ^'^ 1 



T, . becomes: 
1,1 



T-, . ~ Y + 2^ C h 

1,1 o l,2r i+1 

r=2 



2r 



This gives a truncation error of the order h. 



i+1 



Knowing Tq, i+2 also, Ti, i+i can be generated 
(equation 3) , and: 



T - T 

T . = T , + ^'^+^ I'i 



2,i 1, i+1 4 

2-1 



(4) 



^i,k = ^(^k) (k = 0,1.2, ...,2^ 



Thus: 



the trapezoidal rule gives approximations T, 
to the integral value y: 



0,1 



r=3 



I k=0 
Then the following can be written: 



(2) 



T = y + 
0,i ^ 



E 



r=l 



^0,2r-^ 



2r 



with unknown coefficients Cq or ^^^^ ^° ^°^ 
depend on i. Thus there is a truncation error 
of the order hj^. 

Knowing two successive approximations, Tq.I 
and T , we can generate an extrapolated value: 



T = T + 

l,i 0, i+1 



T - T 

0,i+l 0,i 

22-1 



(3) 



This is a better approximation to y because: 

CO 



\i= ^'T2 



2-1 r=l 



-^o.a/N.f-r) 



Noting that 2^ h.^^ - h.^ = and setting: 



"'"■S,2r. ^ ^'" -'"'>%,, 



with a truncation error of the order h. Observe 
that the order of truncation error increases by 2 at 
each new extrapolation step. 

Programming Considerations: 

The subroutine uses the scheme shown in Figure 1 
for computation of T values and generates the 
upward diagonal in the one-dimensional storage 
array AUX, using the general formula: 



T -T 

T z^ ^ k-l,j+l k-l,j 

k,j k-l,j+l „2k 



(5) 



2-1 

(k+j = i, j = i-l, i-2 2,1,0) 

and storing: 

T. . Into AUX (i+ 1) 
0,1 ' 



T, . _ into AUX (i) 
1,1-1 ^ ' 



''''' 2^1 



1 2 2r 

(2 -2'') . C 



0,2r 



Tj^ Q into AUX (1) 
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Truncation error 


0(hf) 


O(h^) 


0(hf) 


0(hf)... 


step length 

h. 
1 


\ J 
i \ 





1 


2 


3 ... 


b-a 





H 


;'.oi 


M 


>■■• 


b-a 
2 


1 


'°\ 


;'■'( 


h,\ 


1 


b-a 
4 


2 


'oA 






b-a 
8 


3 


o,o J 






: 


• 


• 





• Subroutine QGn(n= 2, 4, 8, 16, 24, 32, 48) 



Figure 1. Computation of T-values (QATR) 

The procedure stops if the difference between two 
successive values of AUX (1) is less than a given 
tolerance, or if the values of AUX (1) start oscillat- 
ing, thus showing the influence of rounding errors. 



QG2.. 






0G2 


10 


/*««««« 


«#,»,****«««»»**«*4**««*««*««***«****** .****#*».*****»****«****/QG2 


20 








*/0G2 


30 


/• 


INTEGRATION CF GIVEN FUNCTION BY 2-PCINT GAUSSIAN 


*/QG2 


AC 


/* 


CUAORATURE FORMULA 




*/QG2 


50 








*/QG2 


60 


y »**»»*«*♦**««*»♦»#♦••♦**«***•«•*«»*********♦•«***«*******»*♦«**•»****/ QG2 


70 


PROCEDURE t XL, XU,FCT,Y),. 




0G2 


80 


DECLARE 




QG2 


90 




(XLtXUiY.A,B) 




0G2 


ICO 




BINARY FLOAT, /'SINGLE 


PRECISION VERSION 


/•S«/QG2 


110 


/♦ 


BINARY FLOAT (53), /*0OU6LE 


PRECISION VERSION 


/*0*/QG2 


120 




FCT ENTRY RETURNS 




0G2 


130 




(BINARY FLOAT),. /"SINGLE 


PRECISION VERSION 


/♦S*/0G2 


\W 




(BINARY FLOAT (531).. /*DOUBLE 


PRECISION VERSION 


/»D»/QG2 


150 


A 


=0.54(XU*XL).. 




QG2 


160 


B 


=XU-XL,. 




QG2 


ITC 


Y 


=2.8e6751345*9'i8128E-01*B,. 




0G2 


180 


V 


=0.5»6*lFCT(A+Y»tFCTIA-Y)),. 




0G2 


190 


END 


/♦END CF 


PROCEDURE QG2 


*/QG2 


200 



CG4.. 




QG4 


10 




••••*/0G4 


2f 


/* 




• /QG4 


3 


/* 


INTEGRAIICN CF A GIVEN FUNCTION BY A-POINT GAUSSIAN 


• /QGI 


AO 


/• 


CUAORATURE FORMULA 


*/QG4 


50 


/• 




• /QGA 


60 


/»*•**! 




♦♦♦♦*/QGA 


70 


PROCEDURE IXLtXU.FCT.Y),. 


OGA 


80 


DECLARE 


OGA 


90 




(XL, XL, V, A, B, CI 


QG4 


100 




BINARY FLCAT, /*S1NGLE PRECISION VERSION 


/*S*/QGA 


110 


/• 


BINARY FLCAT 153), /•DOUBLE PRECISION VERSION 


/*D*/OGA 


120 




FCT ENTRY RETURNS 


QGA 


130 




(BINARY FLOAT!,. /'SINGLE PRECISION VERSION 


/•S«/0G4 


lAO 


/• 


(BINARY FLOAT 153)),. /•DOUBLE PRECISION VERSION 


/*0*/QGA 


150 


A 


=0.5*(XU+XL!.. 


QG4 


160 


B 


=XU-XL,. 


QG4 


170 


C 


=4.3C56ei55 797C263E-01*B,. 


OGA 


180 


Y 


= l.7 392 7<^Z2 5t87269E-0l*(FCT(A*C)*FCT(A-C)l,. 


0G4 


190 


C 


= 1.69990 52 17^242 8 1E-01*B,. 


OGA 


200 


Y 


=B»(Y+3.26072577'.31273lE-01*(FCT(Ai-CJ+FCT(A-C(»),. 


OGA 


210 


END 


/•END CF PROCEDURE 0G4 


• /QGA 


220 



0G8.. 






0G8 


10 


/*•••*. 




•**«*•««*««*«**««***«*«•**«******* 


•••••/QG8 


20 


/• 






• /QG8 


30 


/* 


INTEGRATION CF A GIVEN 


FUNCTION 6Y e-PCINT GAUSSIAN 


• /0G8 


40 


/* 


CUAORATURE FORMULA 




• /0G8 


50 


/• 






• /OGS 


60 


/**»**i 






•*»**/QG8 


70 


PRCCECUREIXL,XU,FCT,Y),. 




QGe 


80 


DECLARE 




0G8 


90 




(XL,XU,V,A,B,C) 




0G8 


100 




BINARY FLCAT, 


/•SINGLE PRECISION VERSION 


/•S^/0G8 


110 


/* 


BINARY FLCAT (53), 


/•DOUBLE PRECISION VERSION 


/•D^/0G8 


120 




FCT ENTRY REILRNS 




0G8 


130 




(BINARY FLOAT), 


/•SINGLE PRECISION VERSION 


/•S*/QGe 


140 


/* 


(BINARY FLOAT (531), 


/•DOUBLE PRECISION VERSION 


/•D*/QG8 


150 




LY BINARY FLCAT (531, 




QG8 


160 




X( 8) BINARY FLOAT (53; 


STATIC INITIAL 


0G8 


170 




( A. 8C 1AA92 8246768 lE-01, 


5.061A26814518ai3E-02, 


QG8 


180 




3.98333238706ei3AE-Cl, 


1.111905172266872E-01, 


QG8 


190 




2.62 76620495 6 16A5E-C1, 


l.56e533229389A36E-01, 


QG8 


200 




9.l7173212A7e2A9CE-02, 


I. 8 1341 89 16891 81 Oe-01),. 


OGS 


210 


A 


=0.5*(XL+XL»,. 




QG8 


220 


B 


=XU-XL,, 




OGS 


230 


LY 


= 0,. 




0G8 


240 




CO 1=1 TO 7 BY 2.. 




OGS 


250 




C =X(I)*B,. 




OGS 


260 




LY =LY+X(Itl)*(FCT(A* 


C!*FCT(A-C) ),. 


OGS 


270 




END,. 




OGS 


280 


Y 


=LY*B.. 




QGE 


290 


END, 




/•END CF PROCEDURE QG8 


• /0G8 


300 



QGie.. 






QGI6 


10 


/«*«•*«*****«***«***«•*«•«*»*»« 


♦••♦**»*t»««*,«*«*»**#»**t**»*ft*******#/QGi6 


20 


/• 






*/0G16 


30 


/* 


INTEGRATION CF A GIVEN 


FUNCTION BY 16-PCINT GAUSSIAN 


♦/QGI6 


40 


/• 


CUAORATURE FORMULA 




*/0G16 


50 


/• 






♦/QG16 


60 




«**««*•***••*«««««««:««*««* #4 «#«**« 


***««/QGl6 


70 


PROCEDURE! XL, XU, FCT, V),. 




QGI6 


80 


DECLARE 




0G16 


90 




!XL,XU,Y,A,B,C) 




QG16 


100 




BINARY FLOAT, 


/•SINGLE PRECISION VERSION 


/•S*/QG16 


110 


/♦ 


BINARY FLOAT (53), 


/•DOUBLE PRECISION VERSION 


/•D*/QG16 


120 




FCT ENTRY RETURNS 




0G16 


130 




(BINARY FLOAT), 


/•SINGLE PRECISION VERSION 


/♦S*/QGI6 


140 


/• 


(BINARY FLCAT (531 ) , 


/•DOUBLE PRECISION VERSION 


/•C*/0G16 


150 




LY BINARY FLCflT (53), 




0G16 


160 




X(16) BINARY FLOAT (53; 


STATIC INITIAL 


0G16 


170 




(A.9470046 7'(95 62 5CE-C1, 


1.357622 9 705 87705E-02, 


0G16 


180 




4.72287^115366163E-01, 


3.112676I96';32395E-02, 


0G16 


190 




4.32815 60L19 3S159E-C1, 


4.75792 5^841 2 A6i9E-02, 


0616 


200 




3.777022C4L775C15E-C1, 


6,2 3l'.4e5fc2 7 76694E-02. 


0G16 


210 




3.C8938122201321'5E-C1, 


7.4797994408288376-02, 


QG16 


220 




2.29CC6388a2B6137E-Cl, 


8.45732596g75C127£-02, 


0G16 


230 




1.4080L7753896295E-CI, 


9.13O1707522A6179E-02, 


QG16 


240 




A.750625A9ie8ie72E-C2. 


9. 47253 5 227 5 3425 E~02).. 


QG16 


250 


A 


=0.5«(XL+XL),. 




QG16 


260 


6 


=XU-XL,. 




0G16 


270 


LY 


= 0.. 




0G16 


280 




DO 1=1 TO 15 BY 2,. 




0G16 


290 




C =X(I)^B,. 




0G16 


300 




LY =LY+X(I*1J^(FCT(A*C)+FCT(A-C) ),. 


0G16 


310 




END,. 




0G16 


320 


Y 


=LY*B,. 




QG16 


330 


END. 


• 


/•END CF PROCEDURE QG16 


•/QG16 


340 
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0G2*.. 








QG24 


10 




****./0G24 


20 


/• 








*/QG24 


30 


/* 


IMEGRATICN Cf A CIVEN 


FLNCTICN BY 2A-PCINT GAUSSIAN 


♦/0G24 


4C 


/* 


CUADRATURE FCRHULA 






•/0G24 


50 


/♦ 








•/0G24 


60 


/»*•»***•»*********«♦*«•#»•♦,****«*,*«««,»♦*„,*«»**,**«* *«*»:,^#,,,,«*/Qg24 


70 


PRGCECURE(XL,XU,FCT,V),. 






0G24 


RO 


DECLARE 






CG24 


90 




(XL.XU.V.A.8.C) 






QG24 


ICO 




BINARY fLCAT, 


/•SINGLE PRECISICN 


VERSION 


/♦S*/0G24 


110 


/* 


BINARY FLCAT (53), 


/♦DOUBLE PRECISION 


VERSION 


/*0^/QG24 


120 




FCT ENTRY RETURNS 






0G24 


130 




(BINARY FLOAT), 


/•SINGLE PRECISICN 


VERSION 


/♦S^/0G24 


140 


/♦ 


(BINARY FLCAT (53)) , 


/♦DOUBLE PRECISICN 


VERSION 


/*D*/QG24 


150 




LY BINARY FLCAT (53), 






0G24 


160 




X(2'.) BINARY FLCAT (53) 


STATIC INITIAL 




I3G24 


170 




(4.'575^36C99Se5IC7E-0l, 


6,1706l'.899993600E-03 




QG24 


180 




'i.8736<.277S85654 7E-Cl. 


l.<V265694 3K4668 3E-02, 




0G24 


190 




4.691372760013fcf'.E-Cl, 


2.2138719'.0870990E-0?, 




0G24 


200 




4.'.32C77635C?2CC5E-Cl , 


2.S6'i9Z9 24 5771839F-02, 




0G24 


210 




4.100009S2986S515E-GU 


3.66732'i070554C15E-02, 




QG24 


220 




3.7CC620S57892772E-C1. 


'..3095C8G7659766'.E-02. 




0G24 


230 




3.2A0A6e25966^87eE-Cl, 


4. 88093260 52056 94 E-02, 




0G24 


240 




2.727107356S^^19eE-Cl, 


5.372213505798282E-02, 




0G24 


250 




2. 16896 7538 13C226E-C1, 


5. 7752834026862 80E-02, 




0G24 


260 




1.5752133^84ecei7E-01, 


6. C83523 646390 170E-02. 




0G24 


270 




9- 5 5 59433 736 see 1 5E-02, 


6. 2918 7281 734 14 15E-02. 




QG24 


280 




3.2028'.^6'i313C28lE-C2. 


6.396909767337608E-02) 




QG24 


290 


A 


=0.5*IXUtXL),. 






0G24 


300 


e 


=XU-XL,. 






0G24 


310 


LY 


= 0,. 






0G2'i 


320 




CO 1=1 TO 23 BY 2,. 






QG24 


330 




C =X(I)*B,. 






0G24 


340 




LY =LY+X(I*i)*(FCT(A+C)*FCT(A-C) ),. 




0G24 


350 




END,. 






QG24 


360 


Y 


=LY»8,. 






0G24 


37C 


END 




/•END CF PROCEDURE 


0G24 


*/0G24 


380 



QG32.. 








QG32 


10 


/» 




•****•****•**•««****««•***** ******«**«*/ 0G32 


20 


/♦ 










♦/QG32 


30 


/• 




INTEGRATION CF A GIVEN 


FUNCTION BY 3Z-PC1NT GAUSSIAN 


•/QG32 


40 


/♦ 




CUADRATURE FORMULA 






*/QG32 


50 


/• 










•/QG32 


60 


/• 


H**1 




»*«•*«»«•«*• *4*4**««*««**««*«ik *«»«*****/ Q(;32 


70 




PROCEDURE! XL, XU, FCT, Y),, 






QG32 


80 




DECLARE 






QG32 


90 






(XL,XU,Y,A,B.C) 






OG32 


100 






BINARY FLOAT, 


/•SINGLE PRECISION 


VERSION 


/*S*/QG32 


110 


/ 




BINARY FLCAT (53), 
FCT ENTRY RETURNS 


/•DOUBLE PRECISION 


VERSION 


/•D«/0G32 
gG32 


120 
130 






(BINARY FLOAT). 


/♦SINGLE PRECISION 


VERSION 


/•S^/QG32 


140 


1 




(BINARY FLOAT (53)), 
LY BINARY FLCAT (53), 


/♦DOUBLE PRECISION 


VERSION 


/•D*/QG32 
QG32 


150 
160 






X(32) BINARY FLOAT (53) 


STATIC INITIAL 




0G32 


170 






(4.9e63193C92474C8E-0l, 


3.509305004735048E-03 




QG32 


180 






4.92a05755772£342E-Cl, 


8.I37197365452835E-03, 




QG32 


190 






4.823811277937532E-C1, 


1. 269603265463 103E-02, 




0G32 


200 






4.6745303796t8698t-Cl, 


1.71 3693 14565 1C72E-Q2, 




QG32 


210 






4.4816057 7883C26iE-01, 


2. 1417949011 11334E-02, 




0G32 


220 






4.246838068662e50E-Cl, 


2.5499029631 18809 E-02, 




QG32 


230 






3.9724169 7983S712E-01, 


2.934204673926777E-02, 




QG32 


240 






3.66C910 5937C144eE-Cl, 


3.2911lll388ie092E-02, 




QG32 


250 






3.3152213346;iC76E-01, 


3. 61 7289 70544242 5E-02, 




0G32 


260 






2.93E57e7862C38l2E-Cl, 


3.909694 7 89 35 3515E-02, 




0G32 


270 






2. 5 3449954466 L147E-01, 


4. 1655962 11 347338 E-02, 




QG32 


260 






2.10675638C653177E-CI, 


4. 382604650220 191 E-02, 




QG32 


290 






1.65934301141C638E-01, 


4. 5 58693934788194 E-02, 




QG32 


300 






1.19643681126Cfce5E-Cl, 


4.6922 19954040228E-02, 




QG32 


310 






7,22359e079l39e25E-C2, 


4. 78193600 3963743E-02, 




0G32 


320 






2.41538 32e43efc916E-C2, 


4.827004425736390E-02I 




0G32 


330 




A 


=C.5*(XL+XL),. 






0G32 


340 




B 


=XU-XL,. 






0G32 


35C 




LY 


00 1=1 TO 31 BY 2t. 
C =X(I)^6,. 






QG32 

QG32 
QG32 


360 
370 

380 






LY =LY+X(1+1)^(FCT(A+ 


C)+FCT(A-C)),. 




0G32 


390 






END,. 






QG32 


400 




Y 


=LV+6,. 






QG32 


410 




END, 




/•END CF PROCEDURE 


QG32 


•/QG32 


420 



CG48.. 






QG48 


10 


/*»***»«*».#«**«**«»*«t**«******ft*»4«****«»*»»»*«*«*«M*«***«*«***»*#*/QGA6 


20 


/• 






♦/QG46 


30 


/♦ INTEGRATION CF A GIVEN 


FUNCTICN BY 48-PCINT GAUSSIAN 


•/QG48 


40 


/♦ CUADRATURE FCRKULA 






•/QG46 


50 


/• 






*/QG48 


6C 


/*«#4 4««4««*»««4«*4««f «**«**« **«4«4*«««.»««»*««4(,««»«»»«« 


t***#»******«*/QGA8 


70 


PRCCEDURE(XL,XU,FCT,V),. 






0G46 


80 


DECLARE 






QG46 


90 


(XL,XUtY,A.B.C) 






QG48 


100 


BINARY FLCAT, 


/•SINGLE PRECISION 


VERSION 


/♦S^/QG48 


110 


/* BINARY FLCAT (53), 


/♦DOUBLE PRECISION 


VERSION 


/•D*/QG48 


120 


fCT ENTRY RETLRNS 






QG48 


130 


(BINARY FLOAT) , 


/♦SINGLE PRECISION 


VERSION 


/•S^/QG48 


140 


/* (BINARY FLOAT (53)) , 


/♦DOUBLE PRECISION 


VERSION 


/♦D^/QG48 


150 


LY BINARY FLCAT (53),. 






QG48 


160 


DECLARE 






QG48 


17C 


X(24) BINARY FLCAT(53) 


STATIC INITIAL ( 




QG48 


180 


4.993855036262131E-C1, 


4.96 7650861331754E-01, 




QG48 


190 


4.9206229186I4I34E-C1, 


4.85295 796 2731236E-01, 




0G48 


200 


4.T64938515 802154E-C1, 


4.65fc9 334 53 53 2772E-01, 




QG48 


210 


4.5293956e3577848E-Cl, 


4.38286C10t371239E-01, 




QG48 


220 


4.2 17941308 12 196 8E-C1, 


4.035331020147213E-01, 




QG48 


230 


3.8357951t257e7C2E-Cl, 


3.620170654619073e-01, 




0G48 


240 


3.389 3ei8SBlt332CE-Cl. 


3.1443369 83 86 2 568E-01, 




QG46 


250 


2.8e612363041S8fc4E-01, 


2.615804873611165E-01, 




QG48 


260 


2.334514523754792t-Cl, 


2.04343240 9S5 35 84E-0i, 




QG46 


27C 


I.74 37794 3146C8C4E-C1, 


1.43681243t777Z78E-01, 




QG48 


280 


1.123818951973445E-01, 


8.061117803444586E-02, 




QG46 


290 


4.85C23496047 3135E-C2, 


1.61900 8548 14 3468E-02), 




QG48 


300 


CECLARE 






QG48 


310 


h(24) BINARY FLCAT(53) 


STATIC INITIAL ( 




QG48 


32C 


1.576673026152919E-03, 


3.663776950638131E-03, 




0G48 


330 


5.7386172e96l727CE-C3, 


7. 789657 86147 I924E-03, 




0G48 


34C 


9.6080802286 7 7764E-C3, 


l.t78538041966219E-02, 




QG48 


350 


1.37l3254e5417e47E-C2, 


1.55a361391639904E-02, 




QG48 


360 


1.738861128238522E-C2, 


1.912067553291535E-02, 




0G48 


370 





2. 077254 147173237E-C2, 


2. 2337 28042834 7I4E-02, 


QG48 


380 




2. 380 83292462 4 524E-C2, 


2. 5 17951 777692 724E-02, 


0048 


390 




2.644 5CS4 742 5S6e3E-C2, 


2. 759975 184999208E-02, 


QG48 


4C0 




2.e63G646C502C16iE-02, 


2.9557419 84 9 19782E-02, 


0048 


410 




3.03522195e294694E-C2, 


3.1C1971157994633E-02, 








3. 1557096 143 127C1E-C2. 


3.1962119292324C9E-02, 


QG48 


430 




3.22330f2217975C4£-C2, 


3. 236684840634 196E-02),. 






A 


=0.5*(XU*XL),. 




0G46 


450 




=XU-XL,. 




0G48 


46C 








0046 


47C 




DC 1=1 TO 24,. 




QG46 


480 




C =X(n«6,. 




QG48 


490 




LY =LV»hU )^(FCT(A+C) 


+FCT(A-C)),. 








END,. 




0G48 


510 


^ 


=LY»6,. 




0G46 


520 






/•END CF PRCCECURE CG46 


•/0G48 


530 



Purpose: 



XU 



QGn computes the integral value Y J FCT(X) dX 

XL 
for a given function FCT (X) defined in the 

closed interval [XL, XU], using Gaussian 

quadrature formulas. 

Usage: 

CALL QGn (XL, XU, FCT, Y); 

XL - BINARY FLOAT [(53)] 

Given lower bound of the integral. 

XU - BINARY FLOAT [(53)] 

Given upper bound of the integral. 

FCT - ENTRY 

Given procedure for the computation of 
the function values, which must be supplied 
by the user. 

Usage: 

FCT(X) 

FCT(X) - BINARY FLOAT [(53)] 

Resultant function value. 
X - BINARY FLOAT [ (53)] 

Given argument value. 
Y - BINARY FLOAT [(53)] 

Resultant integral value. 

Remarks: 

The number n within the procedure name QGn 
indicates the number of nodes used for calculation 
of Y. 

Method: 

Gaussian quadrature formulas are used for the 
evaluation of the integral values. 

For reference see: 

V. I, Krylow, Approximate Calculation of Integrals , 
Macmillan, New York-London, 1962, pp. 100-111 
and 337-340. 
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Mathematical Backgrotind: 

Set: 

xi = lower bound of integral 
Xu = upper bound of integral 
n = number of nodes used for the evaluation 
of the integral value. 

By means of the linear transformation 



Subroutine QLn (n = 2, 4, 8, 12, 16, 24) 



x = t^ + t^t 



X + x_ 



with t„ = " „ and t, = 



X -X 
u 1 



(1) 



the argument range x ^ x s x is mapped onto 
1 

-1 s t s + 1 



and the integral 

X 

y = P f(x)dx 

X 

1 

is reduced to standard form 
+1 
y = / <p(t)dt 



(2) 



(3) 



with(p(t) = t^i{t^ + t^t). 

Gaussian quadrature formulas are used to compute 
(3). 

The integral value y is approximated by a weighted 
sum of fimction values: 



M _ 



= 2t^ E 



k=l 






The value y'*^^ is exact whenever f (x) is a poly- 
nomial of degree less than or equal to 2n-l, 

The weights A^) and nodes t^'^' are ssonmetric 
with respect to the origin t = 0: 



(n) _ (n) (n) _ (n) 

\ ~ n-k+1 ' \ n-1 



k+1 



QUADRATURE FORMULA 



***«*♦» 



PROCEDURE (FCTjY) ,. 
DECLARE 

FCT ENTRY RETURNS 

(BINftRY FLOAT), ^ * 

* (BINARY FLOAT (53)1 , /* 

(X,V) 

BINARY FLOAT,. /' 

■» BINARY FLOAT (531 ,. /" 

X =3.414213 562 3 73095E*-00, . 

Y =l.Aft4'.66C9',067262£-01*FCT(X) ,. 
X =5.8578 6'»37626905CE-01.. 

Y =Y+8.535533905932738E-01*FCT(: 



*»*»*#♦**•***♦«** 



SINGLE PRECISION VERSION 
DOUBLE PRECISION VERSION 



SINGLE PRECISION VERSION 
DOUBLE PRECISION VERSION 



END, 



/»END OF PROCEDURE 012 



0L2 


IC 


«*«*/ql: 


20 


*/QL2 


■3f 


IE */QL2 


40 


•/13L2 


5C 


•/0L2 


60 


»«**/QL2 


70 


0L2 


80 


QL2 


90 


0L2 


100 


/*S»/0L2 


110 


/*D*/QL2 


120 


0L2 


1-50 


/»S«/0L2 


140 


/*D*/QL2 


15C 


0L2 


IbO 


QL2 


170 


0L2 


180 


0L2 


190 


*/0U2 


200 



;«;;...».........»......•...••••♦•••••••••«••••♦••• •♦•♦•••••••••"•;^jj;j 

/* INTEGR»tION OF > GIVEN FUNCTION BY 4-POINI G«ISSI«N-IAGU€IM<E VOl.* 

/. QUiORATURE FORKUIA V/ail 

/*,»...«.*.»..«.•«•••»»•••♦•••••«•••••••••••»•♦•••••••♦♦••••••*•••••*'"■* 

PROCEDURE (fCf.rli. 



/•SINCLE PRECISION VERSION 
/•DOUBLE PRECISION VERSION 



DECLARE 

FCI ENTRY RETURNS 
(BINARY FLOAT), 
• IBINARY FLOAT (53)1, 
(X,Yt 

BINARY FLOAT,. 
> BINARY FLOAT (53),. 
X =9.395070912301133E*00,. 

Y =5. 3929^70556 13275E-0**FCT(X) .. 
X =4. 536620296921128E+00,. 

Y =Y*3. 8887 9085 1500538E-02*FCT(X),, 
X =1.74576110U58347E*00,, 

Y -Y^S.ST+lSfc^^TT^tE-Ol'FCKX) ,. 
X -3.225476896193923E-01,. 

Y =Y*6.031541043416336E-01»FCT(X),. 

ENIj,. /»ENO OF PROCEDURE QL4 



OLA 

QL4 

QL* 

/•SINGLE PRECISION VERSION /•S«/0L4 

/•DOUBLE PRECISION VERSION /•D»/QL4 

OLA 

/•S^/»L4 

/•D^/OLA 

OLA 

QL* 

QL4 

QLA 



QL* 
QL* 
QL* 
QL* 
• /QL* 



90 
100 
110 
120 
130 
1*0 
150 
160 
170 
180 
190 
200 
210 
220 
230 
2*0 







OLB 


10 


/!i«ii***#*«***«***»*****««****«***»****»***#***»»»*******«************'Q*-8 


20 


/* 
/« 








INTEGRATION OF A GIVEN FUNCTION SY S-POINT GAUSSI AN-LAGUCRBE */(JL8 


40 


/* 


QUADRATURE FORMULA 


*/0L8 


60 




70 


PROCEDURE (FCT,Y)t. 


QL8 


90 












(BINARY FLOAT), /*SINGLE PRECISION VERSION 






/* 


IBINARY FLOAT (53)1, /*00U8LE PRECISION VERSION 


/•0»/QL8 














BINARY FLOAT, /»SINGLE PRECISION VERSION 


/*S*/0L8 






BINARY FLOAT (531. /♦DOUBLE PRECISION VERSION 


/*D*/QL8 














LY BINARY FLOAT (53», 








X(I6) BINARY FLOAT (531 STATIC INITIAL 








(2.286313173688926E*Clt 1 .04e00117487l5lOE-09, 








1.574C67864127800E+01, 8.4857467I6272532E-07, 








1.0 758516 01C18100E*01, 9.076508773358213E-05, 








7.04590 5402393466E*00, 2.79 45 362352 25673E-03, 








4.2667001 7C2 87659E*-00, 3.3343492261 2 1565E-02, 








2.2510B6629866131E*00, 1 .757949866371718E-01, 








9.037017767993799E-01, 4. 187867808143430E-01, 








1.7C2T96323C51010E-01, 3.69l8e5893416375E-011 , . 










OLB 


270 




DO 1=1 TO 15 BY 2,. 


0L8 






XX =X(I).. 


QL8 






LY =LY+X(I*U*FCTtXX),. 










QL8 








QL8 


320 


END 


/•END OF PROCEDURE QL8 


•/0L8 


330 



QL12.. 








0L12 


10 




rm************************''*********************** 




♦♦♦♦♦/0L12 


20 


/• 








♦/0L12 


30 


/♦ 


INTEGRATION OF A GIVEN FUNCTION BY 12-POINT GAUSSI AN-LAGUEPfiE»/QL 12 


40 


/* 


QUADRATURE FORMULA 






*/QL12 


5C 


/* 








•/0L12 


60 


/***»**.»■*******«*«******♦»***«•********♦********♦*♦****** 


*««*«**«*•«« k/CL 12 


70 


PROCEDURE IFCT.Y),. 






QL12 


80 


DECLARE 






0L12 


90 




(XX.Y) 






0L12 


100 




BINARY FLOAT, 


/♦SINGLE PRECISION 


VERSION 


/♦S^/QL12 


110 


/* 


BINARY FLOAT 153) . 


/♦DOUBLE PRECISION 


VERSION 


/♦D«/0L12 


120 




FCT ENTRY RETURNS 






0L12 


I 30 




(BINARY FLOAT)* 


/♦SINGLE PRECISION 


VERSION 


/♦S*/QL12 


140 


/* 


(BINARY FLOAT (53)), 


/♦DOUBLE PRECISION 


VERSION 


/♦D«/QL!2 


15C 




I BINARY FIXED, 






0L12 


160 




LY BINARY FLOAT (53), 






QL12 


170 




X(24) BINARY FLOAT (53) 


STATIC INITIAL 




0L12 


180 




(3.7099121C4446692E+01, 


8. 148077467 426242E-16 




QL12 


190 




2.848796725C98400E.+01, 


3.C616016 3 50 35021E-12, 




0L12 


200 




2.2151C9C3793 9701E+01, 


1.342 391 0305 15004E-09, 




0LI2 


210 




1.7116855 ie74622fcE*0l, 


1.668 4935 765409 1 OE-07, 




0L12 


220 




1.30060 54993 3063 5E*0I, 


8.36 5C5 5 856819799E-06. 




QL12 


230 




9.621 31 68 4245686 7E*00, 


2.C32 3l5926629q94e-04, 




0L12 


240 




6.844525453 115177E+00, 


2.663973 541865316E-03, 




QL12 


250 




4.599227639<tl8348E+00, 


2. CIC 238 11 5463410 EH32. 




CH2 


26C 




2.8 337513 3 77435C7E*00, 


9.C4492 2 221168093E-02, 




0L12 


270 




1.51261C2 69776419E+00, 


2.4408201 13 I98776e-01, 




QL12 


280 




6.1I7574846151307E-01, 


3.7775 92758 7 31380E-01, 




QL12 


290 




I.1572211735 802C7E-01, 


2.64 7313710554432E-01) 


. 


0L12 


300 


LY 


=0,. 






0L12 


310 




DO 1=1 TO 23 BY 2,. 






QL12 


320 




XX =)t(n,. 






QL12 


330 




LY =LY+X(I»1)»FCT(XX» 






0L12 


340 




END,. 






0L12 


350 


V 


=LY,. 






QL12 


360 


END 




/♦END OF PROCEDURE 


0L12 


♦/0L12 


370 
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0L16.. 






0L16 


10 


/■**************************ti*********.*********ti***1l**«**t«***t******1ft:/Ql_ 16 


20 








*/0LI6 


30 




INTEGRATION OF A GIVEN 


FUNCTION BY 16-POINT GAUSST AN-LAGUEBPE*/OL 16 


40 




QUADRATURE FORMULA 




*/QL16 


5C 








♦/0L16 


60 


/****«*«i««*«*«**««4r« *«*«««:* »«»«««** *«****»***«****«*«** ********** 


♦*«**/0L16 


70 


PROCEDURE (FCT.Y),. 




QL16 


80 


DECLARE 




QL16 


90 




FCT ENTRY RETURNS 




CL16 


100 




(eiNAPY FLOAT), 


/♦SINGLE PRECISION VERSION 


/♦S+/QL16 


110 


/* 


(BINARY FLOAT (53)), 


/♦DOUBLE PRECISION VERSION 


/•0*/QL16 


120 




(XX, Y) 




0L16 


130 




BINARY FLOAT, 


/♦SINGLE PRECISION VERSION 


/♦S^/0L16 


140 


/* 


BINARY FLOAT (53), 


/♦DOUBLE PRECISION VERSION 


/*0^/OL16 


15C 




I BINARY FIXED, 




QL16 


160 




LY BINARY FLOAT (53), 




0H6 


!70 




X(32) BINARY FLOAT (53) 


STATIC INITIAL 


QLi6 


180 




(5.17C11603395<.3 32E+01, 


4.161462 370372855E-22, 


0L16 


190 




4.l94C't52 6A768833E*-0l, 


5. 05047370003551 3E-1 8, 


QL16 


2C0 




3.4 583398 702 286636+01, 


6.29T96 700 2517B68E-15, 


QL16 


210 




2. 8578729742882 14E*0l, 


2.127079033224103E-12, 


QL16 


220 




2.35159C569399191K+01, 


2.86235C242973882E-10, 


QH6 


230 




1. 91 80166 8^6 7 53 13E+01, 


1.8f 102484107 96736-08, 


QL16 


240 




1.5441527368781626+01, 


6.8?8 3193 308712 00E-07. 


QL16 


250 




1.221422336886616E+01, 


1.484i,58687398I30E-C5, 


0L16 


260 




9.438 3143 3639 1939E+ 00, 


2.C.&271915 3C82785E-04, 


0L16 


270 




7.07033 8535C48 2 34E+0C, 


1.8490709435263 11 E-03, 


0L16 


280 




5.078ri861454S76aE+00, 


1.1 2999 0008033945E-02, 


QL16 


290 




3. 4370866 33 8932 C7E+0C, 


4.73 28 92 8694125 22E-02, 


QL16 


30C 




2,1292a36450983eiE+00, 


1.362969342963775E-01, 


QL16 


310 




I. 141 057774 831 22 7E+00, 


2.65 79 577 76442142E-01, 


0L16 


320 




4.6269632891508086-01 , 


3.31C57 8 549 508 842E-01, 


0L16 


330 




8,764941047892784E-02, 


2.0615171495780l0e-01),. 


0L16 


340 


LY 


=0,. 




0L16 


350 




DO 1=1 TO 31 BY 2,. 




QL16 


360 




XX =X(I),. 




QL16 


370 




LY =LY+X(I+1)*FCT(XX) 




0L16 


380 




END, . 




QL16 


390 


Y 


=LY,. 




(3L16 


400 


END, 


• 


/♦END OF PROCEDURE QL 16 


*/QL16 


410 



0L24.. 








QL24 


10 


/*'*********«*«^**'^*** **************************************.***********:*/ Ql^Z't 


20 


/* 








♦/0L24 


30 


/* INTEGRATION Of A GIVEN 


FUNCTION BY 24-POINT GAUSS! AN-LAGUERRE«/QL24 


40 


/« QUADRATURE FORMULA 








*/0L24 


50 


/* 








*/QL24 


60 




if*ittH!*ttit'********************'******/Qi_2't 


70 


PRGCEOURE (FCT,Y),. 








QL24 


80 


DECLARE 








0L24 


90 


(XX, Y) 








QL24 


100 


BINARY FLOAT, 




/♦SINGLE PRECISION 


VERSION 


/♦S«/0L24 


110 


/♦ BINARY FLOAT (531, 




/♦DOUBLE PRECISION 


VERSION 


/*D«/QL 24 


120 


FCT ENTRY RETURNS 








QL24 


130 


(BINARY FLOAT), 




/♦SINGLE PRECISION 


VERSION 


/*S*/0L24 


140 


/* (BINARY FLOAT (53)) , 




/♦DOUBLE PRECISION 


VERSION 


/♦D^/QL24 


150 


I BINARY FIXED, 








QL24 


160 


LY BINARY FLOAT (53),. 








QL24 


170 


DECLARE 








QL24 


180 


X(24) BINARY FLOAT(53) 


STATIC INITIAL ( 




QL24 


190 


8.1498?792 3 3 94 889Et01, 


6 


99622400351O503E+O1, 




QL24 


200 


6.105a^3144721876et0i, 


5 


3608 57454469507E+01, 




QL24 


210 


4.71531C644515632E+01. 


4 


1451720484870776+01, 




QL24 


220 


3.6 3 58405 8016 5162E* 01, 


3 


1776041352374726+01, 




QL24 


230 


2. 7635937 1 74332 72E +01, 


2 


388732984816973E+01, 




QL24 


240 


2. 049 1460082 61 642E+01, 


1 


741799264650a98E+0l, 




QL24 


2 50 


1.46427322 895966 7Et0l, 


1 


21461027117Z977E+01, 




QL24 


260 


9.912C9 8015 0777C6E+00, 


7 


927539247172152E+00, 




QL24 


270 


6.1815351L9736765E+00, 


4 


665083703467171E+00, 




QL24 


280 


3.37077 4?642C899 8E»00, 


2 


292562058632 190E+00, 




QL24 


290 


1.42 55975908036 13E+00, 


7 


66C969055459366E-01, 




QL24 


300 


3.112391461984837E-01, 


5 


9C1985218150798E-02), 




0L24 


310 


DECLARE 








QL24 


320 


W(24) BINARY FLOAT(53) 


STATIC INITIAL ( 




0L24 


330 


5.575345788323357E-35, 


4 


088301 593680658E-30. 




QL24 


340 


2.451 81 8845 e78403E-26, 


3 


60 57658645529596-23, 




0L24 


350 


2.0 1051 74645 555C3E-20. 


5 


350188813010038E-19, 




QL24 


360 


7.8198003824 5944 86-16, 


6 


8941810529580866-14, 




0L24 


370 


3.91 77365 15C5845 IE- 12, 


1 


5C7O08226292585E-10, 




0L24 


380 


4. 07285898 755 OOOOE-09, 


7 


9608129591336306-08, 




QL24 


390 


1.1513158127372806-06, 


1 


2544721977993336-05, 




QL24 


400 


1.04461 21 465 92752E-04, 


6 


7216256409354796-04, 




0L24 


410 


3.3693490584783 046-03, 


1 


3226019405120166-02, 




QL24 


420 


4.0732478151408656-02, 


9 


816627262991889E-02, 




QL24 


430 


1.8332268897777806-01, 


2 


588'567072728698E-01 , 




0L24 


440 


2.5 877410 751742 39E-01, 


1 


4281197333478196-01), 




0L24 


450 


LY =0,. 








0L24 


460 


00 1=1 TO 24,. 








QL24 


470 


XX =X( I ), . 








0L24 


480 


LY =LY+W(I )*FCT(XX) , 








QL24 


490 


END,. 








QL24 


500 


Y =LY,. 








QL24 


510 


END,. 




/♦END OF PROCEDURE 


QL24 


«/QL24 


520 



Purpose: ^ 

f -X 

QLn computes the integral value Y = rf e FC T(X)dX 

for a given function FCT(X), by Gaussian-Laguerre 
quadrature formulas. 



Usage: 

CALL QLn (FCT, Y); 

FCT - ENTRY 

Given procedure for the computation of 

the function values. 

This procedure must be supplied by the 

user. 

Usage: 

FCT(X) 

FCT(X) - BINARY FLOAT [(53)] 

Resultant function value, 
X - BINARY FLOAT [(53)] 

Given argument value. 
Y - BINARY FLOAT [(53)] 

Resultant integral value. 

Remarks: 

The n in the name QLn indicates the number of nodes 
used for the calculation of Y. 

Method: 

Quadrature formulas of Gauss-Laguerre are used 
for the evaluation of the integral values. 

For reference see: 

H. E. Salzer, R. Zucker, "Table of Zeros and 
Weight Factors of the First Fifteen Laguerre 
Polynomials", Bui. Amer. Math. Soc. , vol. 55 
(1949), pp. 1004-1012. 

V. I. Krylow, Approximate Calculation of Integrals , 
Macmillan, New York- London, 1962, pp 130-132 and 
347-352. 

Shao, Chen, Frank, "Tables of Zeros and Gaussian 
Weights of Certain Associated Laguerre Polynomials 
and the Related Generalized Hermite Polynomials", 
IBM Technical Report TR 00. 1100, March 1964, 
pp. 24-25. 

Mathematical Background: 

Formulas of Gauss- Laguerre are used to compute 

y = / e ^ f (x) dx 
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Let n denote the number of nodes used for the 
calculation of the integral value y. The value y 
is approximated by a weighted sum of function 
values: 



• Subroutine QHn (n =2, 4, 8, 16, 24, 32, 48) 



M _ 



k=l 



^\ 



(fl). 



f(x,<°^] 



The value y W is exact whenever f(x) is a poly- 
nomial of degree less than or equal to 2n-l. The 
nodes Xj^^^) are the roots of the Laguerre poly- 



nomials LqCx) of degree n. 



QH2.. 


0H2 


10 


/»«4««4.«««:«*«>K :((««**«***«****« ****««*« «*«****************«***********«*/0H2 




/* 


♦ /0H2 


30 


/* INTEGRATICN OF A GIVEN FUNCTION SY 2-POlNT GAUSS 1 AN-HERMITE VOH? 


40 


/* QUADPATURE FORMULA 


*/0H2 


50 


/* 


*/0H2 


60 


/«*«*♦«*****»**** *«*»**»«*************»«*******»******«***********»***/0H2 


70 


PfOCeDU"'E (fCT.V),. 


QH2 


80 


DECLARE 


0H2 


90 


FCT ENTRY RETURNS * 


0H2 


100 


(BINARY FLOAT), /^SINGLE PRECISION VERSION 


/*S*/QH2 


llO 


/» (BINARY FLOAT (53)), /*OOUBLE PRECISION VERSION 


/*0*/0H2 


120 


(X.Y.Z) 


0H2 


130 


BINARY FLOAT,. /*SINGLE PRECISION VERSION 


/*S*i'QH2 


l-tO 


/♦ BINARY FLCAT(53),. /*OOUBLE PRECISION VERSION 


/•O*/0H2 


150 


X =7.0 7106781 1865'.75E-01,. 


QH2 


160 


Z =-X,. 


QH2 


170 


Y =8.862269254527580E-01«(FCT(X>+FCT(Z)),. 


QH2 


180 


END,. /*END OF PROCEDURE QH2 


*/QH2 


190 



QH4.. 






0H4 


10 


/^*:f$::$i*t*****V*** *»**/***********«*«*«************** ***"'■* 




*****/0H4 




/* 






*/QH4 


30 


/* 


INTEGRATION OF A GIVEN FUNCTION 8Y 4-POINT GAUSS I AN-HERH ITE */0H4 


40 


/* 


QUADRATURE FORMULA 




»/0H4 


50 


/* 






*/0H4 


60 


/***♦♦♦*«♦****» »****#»**«***k«*******************«***«**^ 


***«*»«* 


**«**/QH4 


70 


PROCEDURE (FCT.Y),. 




0H4 


8C 


DECLARE 




CH4 


90 




FCT ENTRY RETURNS 




CH4 


100 




(BINARY FLOAT), /*SINGLE PRECISION 


VERSION 


/*S*/0H4 


110 


/* 


(BINARY FLOAT I53J), /*D0U6LE PRECISION 


VERSION 


/*D*/QH4 


120 




M BINARY FL0AT(53I, 




0H4 


13C 




(X.Y,Z) 




QH4 


140 




BINARY FLOAT,, /*SINGLE PRECISION 


VERSION 


/*S*/0H4 


150 


/* 


9INA=?Y FLnAT(531,. /*D0U6LE PRECISION 


VERSION 


/*D*/0H4 


16C 


X 


= 1.6 50690 123885785E*00,. 




0H4 


170 


z 


=-X, . 




0H4 


180 


M 


=8.131283544724518E-02*(FCT(X)+FCT1Z)),. 




OH'f 


190 


X 


=5. 246476232 752903E-01,. 




0H4 


20C 


z 


=-Xt . 




QH4 


210 


Y 


=W*8.049140900055128E-01*(FCT(X)t-FCT(Z)),. 




0H4 


220 


END, 


/*ENO OF PROCEDURE 


0H4 


*/0H4 


230 



QH8.. 




0H8 


10 


/*»*#«**«****»»*****«***«♦«*«««♦******♦*****»*«**•*****•*** ******«****/0H 8 


20 


/* 




• /0H8 


30 


/* 


INTEGRATION OF A GIVEN FUNCTION 8Y 8-POINT GAUSS I AN-HERMI 


TE */QH8 


40 


/* 


QUAORATUFE FORMULA 


*/0H8 


50 


/* 




*/0H8 


60 


/*******♦*************♦**** ***********************:*******************»/0H8 


70 


PROCEDURE (FCT,Y),. 


QH8 


80 


DECLARE 


QH8 


90 




FCT ENTRY RETURNS 


0H8 


100 




(BINARY FLOAT), /*SINGLE PRECISION VERSION 


/*S*/0H8 


no 


/* 


(BINARY FLOAT (53)), /*OOUBLE PRECISION VERSION 


/*0*/0H8 


12C 




(XX, Y) 


0H8 


130 




BINARY FLOAT, /*SINGLE PRECISION VERSION 


/*S*/QH8 


140 


/* 


BINARY FLOAT (53), /*D0U8LE PRECISION VERSION 


/*D*/0H8 


150 




I BINARY FIXED, 


0M8 


160 




LY BINARY FLOAT (53), 


QH8 


170 




XI 8) BINARY FLOAT 153) STATIC INITIAL( 


0H8 


180 




2.930637420 2 5 7244E+0C, 1 .996040722 1136 76E-04, 


OH 8 


190 




1. 9816567566 95643 E»-00, 1 .707798300741 348E-02, 


QH8 


200 




1.157193712446780E*00, 2.078023258148919E-01 , 


QH8 


210 




3.81186990207322 lE-01, 6 .61 1470125582413E-01) , . 


0H8 


220 


LY 


=0,. 


QH8 


230 




DO 1=1 TO 7 BY 2,, 


QH8 


240 




XX =X(I),. 


0H8 


250 




LY =LY+X1I*1)*{FCT(XX)+FCT(-XX)),. 


QH8 


260 




END,. 


QH8 


270 


Y 


=L¥,. 


QH8 


280 


END 


/*EN0 OF PROCEDURE QH8 


*/0H8 


290 















QH16.. 








QH16 


10 


/**♦*♦* 


***t**»*m* ************ *********************** 


****************** /QH16 


20 


/* 








•/OH 16 


30 


/* 


INTEGRATION OF A GIVEN 


FUNCTION BY 16-POINT 


GAUSSIAN-HERHITE ♦/QH16 


40 


/« 


QUADRATURE FORMULA 






•/QH16 


50 


/* 








•/0H16 


60 


/*******************«*<t:«*«***«>l<****************«***« 


»****«**»*«**««***/QHX6 


70 


PROCEDURE (FCT.Y),. 






QH16 


80 


DECLARE 






QH16 


90 




FCT ENTRY RETURNS 






OH 16 


100 




(BINARY FLOAT). 


/•SINGLE PRECI 


SION VERSION 


/•$^/0H16 


110 


/* 


(BINARY FLOAT (53)). 


/♦DOUBLE PR6CI 


SION VERSION 


/♦0^/0H16 


120 




(XX, Y) 






QH16 


130 




BINARY FLOAT. 


/♦SINGLE PRECISION VERSION 


/•S^/QH16 


140 


/* 


BINARY FLOAT (53), 


/•DOUBLE PRECISION VERSION 


/*0*/QH16 


150 




1 BINARY FIXED, 




QH16 


160 




LY BINARY FLOAT (53), 




OH 16 


170 




X(I6) BINARY FLOAT (53) 


STATIC INITI*L( 


QH16 


180 




4. 688 7389393 0581 8E*0C, 


2.65'^807474011ia2e-10, 


QH16 


190 




3. 86944 79C4 86012 3EtO0, 


2.3209808448652HE-07. 


QH16 


200 




3.17699916I979956e+00, 


2.711B60092537882E-05, 


0H16 


210 




2. 5462021 5784748 lE+OO, 


9. 32 28400 86241805 E-04, 


QH16 


220 




1.95 178 79909 162 54E+ 00, 


1.288031153550997E-02, 


QH16 


230 




1.3802 58539198881 E+ 00, 


8.381004139 89BS83E-02. 


QH16 


240 




8.229514491446559E-01, 


2.806474585285337E-01, 


QH16 


250 




2. 734810461 38152 5E-01, 


5. 0792947901661376-01),. 


0H16 


260 


LY 


=0,. 




QH16 


270 




DO 1*1 TO 15 8Y 2.. 




QH16 


280 




XX =X(I),. 




QH16 


290 




LY -LY*-X(I*1)*(FCT(XX1*FCT(-XX)),, 


0H16 


300 




END,. 




OH 16 


310 


Y 


=LY,. 




0H16 


320 


END. 




/♦END OF PROCEDURE 0H16 


*/0H16 


330 
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INTEGRATION OF ft GIVEN FUNCTION BY 24-POINT GAUSSI AN-HERMITE */QH24 



QUADRATURE FORMULA 



PROCEDURE (FCT.V) ,. 
DECLAPE 

FCT ENTRY RETURNS. 

(BINARY FLOAT) , 
« leiNAi^Y FLOAT {53J) , 

(XX, Y) 

"BINARY FLOAT, 
* BINARY FLOAT (53) , 

I BINARY FIXED, 

LY BINARY FLOAT (531 , 

XlJ'f) BINARY FLOAT (531 STATIC INITIAK 



*/QH2« 
*/0H24 

QH24 

0H24 

0H24 

/♦SINGLE PRECISION VERSION /•S*/0H2* 

/♦DOUBLE PRECISION VERSION /♦0«/0H24 

OH 24 

/♦SINGLE PRECISION VERSION /♦S^/QH24 

/♦DOUBLE PRECISION VERSION /♦D^/0H24 

0H24 



fc.Cl592 556142 5740e*00, 
5. 25938292 7668C44E+ 00, 
4. 625662 7 5642376 7E«- 00, 

4. 05 366440 24481 50E+ 00, 

3.5 20CC68i3034525e+00, 

3.012546137565565E+00, 

2.5238810l7C114:'7Et0C, 

2.04<)003573661699E+C0, 

1.58 42 5P01C96l694EtOO, 

1.12676CB176L1245E*00, 

6.7417110 70 3 72122E-01, 

2. 2441 454 7472 5 156E- 01, 

=C,. 

00 1=1 TO 23 BY 2,. 

XX =X(I),. 

LY =LY*X(I + 1)*(FCT(XXH-FCT(-XX)),. 

END, . 

=LY, . 

/♦END OF PROCEDURE QH24 



1. 6643684 96489I09E-16, 
6.58462024 3078 170E-1 3, 
3. C46 254269987564 E-10, 

4.ClR9ni74941430E-0 8, 
2.158?45704902334E-06, 
5.6886916 36404380 E-05, 
8. 2369248268 841 75E-04, 
7. 0483558 10072671 E-03, 
3.74'.5470503230 75E-02, 
1.27 7 396 217845 592E-01, 
2.86I795 35 3464430E-01, 
4.269 31 1638686992E-01), . 



QH24 
0H24 
QH24 
QH24 
0H24 
QH24 
0H24 
0H24 
0H24 
QH24 
QH24 
OH 24 
QH24 
0H24 
0H24 
QH24 
QH24 
QH24 
OH 24 
QH24 
*/QM24 



QH32.. 

/♦ 
/♦ 
/♦ 



!«:**«*«**«*:«*****: 



INTEGRATION OF A GIVEN 
QUADRATURE FORMULA 



/•*♦•«««»*****••*#»«*****»«#**« 
PROCEDURE (FCT.Y),. 
DECLARE 

FCT ENTRY RETURNS 
(BINARY FLOAT), 

/• (BINARY FLOAT (53)) , 

tXX,Yl 
BINARY FLOAT, 

/♦ BINARY FLOAT (53) , 

I BINARY FIXED, 
LY BINARY FLOAT (53), 
X( 32) BINARY FLOAT (53) 
7. 125813909830728E+00, 
6. 4094981 4926 9660E+0C, 
5 . 6 1 2 22 59 4S 5 1 59 1 4E ♦ 00 , 
5. 27 55 5C9 865L 588 06+00, 
4.77 71645C3 502596E+00, 
4. 3055479533 51198E+00, 
3. 85375548547 1445E+0C, 
3.4171674928 185 71 E* 00, 
2.99 249C8250C2374E»0C, 
2.577249 53773231 7E+0G, 
2. 1694991 8360611 2Et00, 
1.76 76541C9463202E+00, 
1.37037641 09528 72E+00, 
9.7650C4635896a23E-Cl , 
5. 84976 76 543 59324E-01, 
1.9484C74156S3993E-01, 
LY =0,. 

00 1=1 TO 31 BY 2,. 
XX -Xdl,. 
LY =LY+X(I + l)*(FCT(XX 
END, . 



FUNCTION BY 32-POINT GAUSSIAN- 



END,. 



=LY, 



♦SINGLE PRECISION VERS 
♦DOUBLE PRECISION VERS 



/♦SINGLE PRECISION VERS 
/♦DOUBLE PRECISION VERS 



TIC INITIAL! 
.31C676427384162E-2 3. 
.231 7365365 18292E-19, 
.19 73440 17092a49E-15, 
.21501021 1326448E-13, 
.9332914633966396-11, 
.C.9B832164770e97E-09, 
.574167792545594E-07, 
,65C585129562376E-06, 
.41f 5 840 6 18 19983E-05, 
.362 6836 5 5 279720 E-04t 
.654 89032 66 54428E-03, 
.755 342 8 8 3157 343E-02, 
. 045813095 59 1261 E-02, 
,5l269734C766'i.25E-0l, 
, 7745 a 142302 5299E-01, 
.752383525928024E-01), 



)*FCT(-XX)) ,. 



/♦END OF PROCEDURE 0H32 



QH32 
♦♦♦♦♦♦♦♦♦/QH32 

♦/0H32 
HEHMITE ♦/0H32 

♦/0H32 
♦/0H32 
♦♦♦♦♦♦♦♦♦/0H32 
0H32 
QH32 
0H32 
ION /♦S^/0H32 
ION /♦O+/0H32 
0H32 
ION /♦S*/0H32 
ION /♦D^/CH32 
OH32 
0H32 
0H32 
CH32 
0H32 
PH32 
0H?2 
0H32 
OH 32 
CH32 
CH32 
0H32 
QH32 
0H32 
OH32 
QH32 
0H32 
OH 32 
0H32 
QH32 
QH32 
0H32 
QH32 
QH32 
0H3? 
»/CH32 



QH48.. 






0H48 


10 




♦♦♦♦♦/QH4a 


20 


/♦ 






♦/QH48 


30 


/♦ INTEGRATION OF A GIVEN 


FUNCTICN BY 4fl-P0INT GAUSS lAN-HERM ITE ♦/0H48 


40 


/♦ OUADRATUPE FORMULA 






♦/QH48 


50 


/♦ 






♦/0H48 


6C 


/*****************»*»'*»*****V*****t****»m****»***i,t^*»**».^^t^^^^tt^,iHtt/D»e,fi 


70 


PROCEDURE (FCT.Y),. 






0H48 


80 


DECLAPE 






0H48 


90 


FCT ENTRY RETURNS 






0H48 


IOC 


(BINARY FLOAT), 


/♦SINGLE PRECISION 


VERSION 


/*S^/0H48 


110 


/♦ (BINARY FLOAT (53)1, 


/♦DOUBLE PRECISION 


V6R510N 


/*0^/OH48 


120 


1XX,Y) 






QH4e 


130 


BINARY FLOAT, 


/♦SINGLE PRECISION 


VERSION 


/♦S^/QH48 


140 


/• BINARY FLOAT (53), 


/♦DOUBLE PRECISION 


VERSION 


/♦D^/0H48 


150 


I BINARY FIXED, 






0H48 


160 


LY BINARY FLOAT (53) ,. 






0H48 


17C 


DECLARE 






0H48 


180 


X(24) BINARY FL0AT(53) 


ST6TIC INITIAL ( 




0H48 


190 


8.9753150819316676+00, 


8 . 3 1 0752 19C704784E+00, 




QH48 


200 


7. 75929551 9 765775E+00, 


7. 2660 46554 164350e+00. 




0H48 


210 


6.810C64578C7414IE+C0, 


6. 3805 64096 1864 llE+00, 




0H48 


220 


5.9710722 2501 3 545E+00, 


5.5773 1698 122 3 729E+00, 




0H48 


230 


5.1962877187923 656+00, 


4. 6257572281 332C9E+00, 




0H48 


240 


4. 4640 145469344596+00, 


4.1C9704603560590E+00, 




QH48 


250 


3.76172 649C22 8358E+00. 


3.4191659 693638856+00, 




0H4e 


260 


3.0612489 886451066+00, 


2.7473 08624622 383E+00, 




0H4e 


270 


2.416 7609046732166+00, 


2.Ce9C86660944276E+00, 




QH48 


280 


I. 76381 75796953 006+00, 


1.4405252201375656+00, 




QH46 


290 


1.1 188 121 524021 5 7E+00, 


7.983C462777e5622E-01, 




0H48 


300 


4. 786463375 944961E-01, 


1.594929358488625E-01), 




QH48 


310 


DECLARE 






QH48 


320 


W(24) BINARY FLGATI53) 


STATIC INITIAL ( 




0H48 


330 


7.9355 51460 7739 97E-36, 


5,9646126933138786-31, 




QH48 


340 


3.685C 360801 5067 CE- 27, 


5.564577468902285E-24, 




OH 48 


350 


3.!e8387323505138E-2l, 


8. 730 1596011 86677E-19, 




QH4e 


360 


1.3 151 59622 fc58409E- 16, 


I.197589865479179E-14. 




QH48 


370 


7.046932 581 545889E- 13, 


2.8152965 3783ei69E-ll, 




QH48 


380 



7.930467495165382E-10, 

2. 46 865699366975 OE-07, 

2.5 28 5990 27748489E-C5, 

9. 56 392 3 198 1941 5 3E-04, 

1.4444961 5749 8110E-02, 

9. 18222970792851 8E-02, 

2. 53961542664 7591E-01, 

=0,. 

00 I-l TD 24,. 

XX =X(I),. 

LY =LY+W(I)^IFCT(XX)+FCT(-XX)),. 

END,. 

==LY,. 



1.6225H135895770E-08, 
2.84 72 58691734848E-06, 
1.751 5043 1 80 11728E-04, 
4.1530 049119775526-03, 
4.C4 756 769 8460 385E-02, 
1.6920447194564116-01, 
3.11C010 30 3779631E-01), 



/♦6N0 OF PROCEDURE 0H48 



QH48 390 
QH48 400 
0H48 410 
QH48 420 
0H48 430 
0H48 440 
0H48 450 
0H4e 46C 
0H48 470 
QH48 480 
0H48 490 
0H48 500 
QH48 510 
♦/0H48 520 



Purpose: 



+C0 



QHn computes the integral value Y= J^ e""^ FCT(X) dX 
for a given function FCT(X), using~Gaussian-Hermite 
quadrature formulas. 

Usage: 

CALL QHn (FCT, Y); 



FCT 



Y- 



Remarks: 



ENTRY 

Given procedure for the computation of the 
function values, \\*iich must be supplied 
by the user. 

Usage 

FCT(X); 

FCT(X) - BINARY FLOAT [(53)] 

Resultant function value. 
X - BINARY FLOAT [(53)] 

Given argument value. 

BINARY FLOAT [(53)] 
Resultant integral value. 



The number n in the name QHn indicates the number 
of nodes used for the calculation of Y. 

In case of an even function f(x) = ^(x^), f(x) may- 
be changed by means of the transformation t 



= x^ into: 







e" <p(t) 



dt 



This is a form suitable to subroutines QAn, the use 
of which saves approximately half of the computation 
time. 

Method: 

Quadrature formulas of Gauss-Hermite are used for 
the computation of the integral values. 

For reference see: 

H. E. Salzer, R. Zucker, R. Capuano, Table of 
Zeros and Weight Factors of the First Twenty 
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Hermite Polynomials , F, Res. Nat. Bur. Standards, 
vol. 48 (1952), pp. 111-116. 

V. I. Krylow, Approximate Calculation of Integrals , 
Macmillan, New York-London, 1962, pp. 129-130 
and 343-346. 

Mathematical Background: 

Quadrature formulas of Gauss- Hermite are used to 
compute 

+00 2 

-X 



• Subroutine QAn (n = 2, 4, 8, 12, 16, 24) 



y = y* e f (x) dx 



Let n denote the number of nodes used for the 
calculation of the integral value y. The value y is 
approximated by a weighted sum of fxmction values: 

(n) ^ . (n) ,, (n), 

k=l ^ ^ 

The value y^ ' is exact whenever f (x) is a polynomial 
of degree less than or equal to 2n-l. 

The nodes Xj^W are the roots of the Hermite 
polynomials H^(x) of degree n. 

The weights Aj^W and the nodes Xj^^^' are 
symmetric with respect to the origin x=0: 



Af ) = A^"^) 



h-k+1 



(n) 



X 



(n) 

h-k+1 



QA2.. 








QA2 


10 


/«*«**« 


**«**««*»**«********************««**>•>•*****•*«*** 


««***********/QA2 


20 


/* 








*/QA2 


30 


/* 


INTEGRATION OF A GIVEN FUNCTION BY ASSOCIATED 2-POINT 


•/QA2 


40 


/♦ 


GAUSSIAN-LAGUERRE QUADRATURE FORMULA 






•/{|A2 


50 


/* 








*/QA2 


60 


/*»t*m9************************».*****»*************************** 


♦•♦•*/QA2 


70 


PROCEDURE (FCT,Y),. 






0A2 


80 


OECLAPE 






QA2 


90 




FCT ENTRY RETURNS 






QA2 


100 




(BINARY FLOAT), /»SINGLE 


PRECISION 


VERSION 


/*S*/QA2 


110 


/* 


(BINAFY FLOAT (53)>, /*OOURLE 


PRECISION 


VERSION 


/*D*/QA2 


120 




(X.Y) 






QA2 


130 




BINARY FLOAT,. /*SINGLe 


PRECISION 


VERSION 


/*S*/0A2 


140 


/♦ 


BINARY FLOAT (53),. /♦DOUBLE 


PRECISION 


VERSION 


/♦D*/QA2 


150 


X 


= 2, 7 247*4671 391 589E*00,. 






QA2 


160 


Y 


=1.6262567089449C3E-01*FCT(X),. 






QA2 


170 


X 


=2. 752551 286084I09E-01,. 






0A2 


180 


Y 


=Y+1. 609828 180011026E+00*FCT IX).. 






QA2 


190 


END. 


/*ENO OF 


PROCEDURE 


QA2 


«/CA2 


200 



QAA.. 






QA4 


10 


/«***«* 




20 


/* 






*/QA4 


30 


/* 


INTEGRATION OF A GIVEN FUNCTION BY ASSOCIATED 4-POINT 


*/QA4 


40 


/* 


GAUSSIAN-LAGUERRE QUADRATURE FORMULA 




*/0A4 


50 


/* 






*/QA4 


60 


/***««*««*«««*«««««»*«««*«* «ir»***««4:«**«*******«*****«****4i««*«******i*/QA 4 


70 


PROCEDURE (FCT,Y),. 




QA4 


80 


DECLARE 




0A4 


90 




FCT ENTPY FETUPNS. 




Qfl4 


IOC 




(BINSRY FLOAT), /*SINGLE PRECISION 


VERSION 


/•S*/QA4 


110 


/* 


(BINARY FLOAT (53)), /*D0U6LE PRECISION 


VERSION 


/•D»/0A4 


120 




(X,Y) 




0A4 


130 




BINARY FLOAT,. /*SINGLE PRECISION 


VERSION 


/*S*/0A4 


140 


/* 


BINARY FLOAT (53),. /*DOUBLE PRECISION 


VERSION 


/*D*/QA4 


150 


X 


=6.5 8efc3568qC12034E*00,. 




0A4 


160 


Y 


=3.9S2C614442 27 352E-04*FCT(X),. 




QA4 


170 


X 


=3.926963 5ri3 58287E-i-00,. 




3A4 


180 


Y 


=Y+ 3. 4 1559660 1482 695E-02*FCT(X),, 




0A4 


190 


X 


= I. 3 390 97 2881 26361 E too,. 




0A4 


200 


Y 


=Y+4. 156C46516297938E-0l*FCT(X) .. 




QA4 


210 


X 


=1.4 53C35215 033171E-01,. 




QA4 


220 


Y 


=Y+1.322294C25116483E+00*FCT1X),. 




QA4 


230 


END, 


/♦END OF PROCEDURE 


QA4 


*/QA4 


240 



QA8., 






0A8 


IC 


/***•*. 


***».**.**,*««**»,„*,«*««,♦**,*,*,*, «*«******»***«*»*«****#«**/QAB 


20 


/« 






*/0A8 


3C 


/* 


INTEGRATION OF A GIVEN 


FUNCTION BY ASSOCIATED 8-POINT 


♦/0A8 


40 


/* 


GAUSSIAN-LAGUERRE QUADRATURE FORMULA 


*/QA8 


50 


/* 






♦ /0A8 


60 


/«««**«*»««I»*L»*»« »***««««*«*«** 


*««»*«*«****«********* ********4*******K</QA 8 


70 


PROCEDURE {FCT,Y),. 




QA8 


80 


DECLARE 




QftS 


90 




FCT ENTRY RETURNS 




QAB 


100 




(BINARY FLOAT), 


/♦SINGLE PRECISION VERSION 


/♦S^/0A8 


110 


/* 


(BINARY FLOAT (53)) , 


/♦DOUBLE PRECISION VERSION 


/•D^/QAB 


120 




(XX, Y) 




QA8 


130 




BINARY FLOAT, 


/♦SINGLE PRECISION VERSION 


/♦S^/0A8 


140 


/* 


eiNABY FLOAT (53), 


/♦DOUBLE PRECISION VERSION 


/*0*/0A8 


150 




LY BINARY FLOAT (53), 




OAB 


160 




I BINARY FIXED, 




QA8 


170 




X(16) eiNAPY FLOAT (53) 


STATIC INITIAL 


OAB 


180 




(2.1984272a4096265E+01, 


5.309614948022364E-IC, 


0A8 


190 




1.497262708842639E+01, 


4. 64 196 16897 3042 lE-07, 


OAB 


200 




L.CO33Z367522134E + 01, 


5.423720185C75763E-C5, 


QA8 


210 




6.'V8 3U542862 7170EtO0, 


1.864568 017 24836 I E-03, 


QAB 


220 




3.8094763 61 4 a49Q7Et 00, 


2. 576062307 10 1995E-02, 


0A8 


230 




l.9C511363503142SE»00, 


1.676200827979717E-01, 


QAB 


24C 




6. 772490876492892 E-01, 


^.612949170570674E-01, 


0A8 


250 




7. 4791882 59681 827E-02, 


1.0 158589 58O33227E+00),. 


OAB 


260 


LY 


=0,. 




OAB 


270 




DO 1=1 TO 15 BY 2,, 




QA8 


28C 




XX =X(I),. 




OAB 


290 




LY =LYtX(I*U*FCT(XX) 


,, 


OAB 


300 




END.. 




0A8 


310 


Y 


=LY,. 




OAB 


320 


END, 




/♦END OF PROCEDURE QA8 


*/0A8 


330 



QA12.. 








QA12 


10 


/*«»«******««»«*************•«««*«*«« i-iCik*************** «**««««*******«/ Q A 12 


20 


/♦ 








*/QA12 


30 


/* 


INTEGRATION OF A GIVEN 


FUNCTION BY ASSOCIATED 12 


-POINT 


*/0A12 


40 


/* 


GAUSSIAN-LAGUERRE QUADRATURE FORMULA 




*/0A12 


50 


/♦ 








♦/0A12 


6C 




«»*«*«»«*«**« ****«« »*««*»«i|>«««**«*: 


*»»*«./0AI2 


70 


PROCEDURE (FCT,Y),. 






0A12 


8C 


DECLARE 






0A12 


9C 




FCT ENTRY RETURNS 






CA12 


IOC 




(BINARY FLOAT), 


/♦SINGLE PRECISION 


VERSION 


/♦S^/0A12 


110 


/♦ 


(BINARY FLOAT (53)), 


/♦DOUBLE PRECISION 


VERSION 


/♦D*/QA12 


120 




(XX, VI 






CA12 


130 




BINARY FLOAT, 


/♦SINGLE PRECISION 


VERSION 


/♦S*/0A12 


140 


/♦ 


BINARY FLOAT 153), 


/♦DOUBLE PRECISION 


VERSION 


/*0*/0A12 


150 




LY PINARY FLOAT (53) , 






0A12 


16C 




I BINARY FIXED, 






0A12 


170 




X(24) BINARY FLOAT (53) 


STATIC INITIAL 




QA12 


IBC 




(3.619136C3606156CE+01, 


3.328736992978218E-16 




CA12 


190 




2. 7661108779 846 C9E*-01. 


1.31692404B615634E-12, 




0A12 


200 




2.1 396755 936 166liE+01. 


6.r9250853997512BE-10. 




0A12 


21C 




1. 6432195067675 31E*01, 


8. 3794 23498 828 59 E-08, 




0A12 


220 




1.2 39044796380947E+01, 


4.3164914098C4667e-06, 




0A12 


23C 




9. 0754342 309612 03E+00, 


1.137738327280e76E-04, 




0A12 


240 




6.36997 5388030635E+00, 


1. 64 r 38496 537 68 35 E-0 3. 




OAl? 


250 




4. 19841 564487841 BE+OO, 


1.409671162014534E-02. 




QA12 


260 




2. 509848097232 12 BE* 00, 


7.A89094100 646149F-02. 




0A12 


270 




1.269 5899401 C3961E+00, 


2. 55*7924 356 91183E-01, 




0A12 


280 




4.54506 6815637603E-01, 


5. 723590 706928860 E-01, 




0A12 


290 




5.0361889U729395E-02, 


8.53a623277373985E-01I 




0A12 


300 


LY 


=€,. 






0A12 


310 




DO 1=1 TO 23 BY 2,. 






0412 


320 




XX =X(I),. 






0A12 


330 




LY !=LY+X(I*1)«FCT(XX) 






0A12 


340 




END,. 






0A12 


350 


Y 


=LY,. 






0A12 


360 


END, 




/♦END OF PROCEDURE 


0A12 


♦/0612 


370 
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0A16.. 








0A16 10 


/,..,.,.,...........„.„„.„...,.„„„„„.„„.„„„.,„„„„„„„ ,4 20 i 










*/QA16 30 


/♦ 


INTEGRATION OF A GIVEN 


FUNCTION BY ASSOCIATED 16- 


POINT 


*/0A16 40 


/• 


GAUSSIAN-tflGUERRE QUADRATURE FORMULA 




•/QA16 50 


/» 








*/QA16 60 


/********«*»**«#**♦*, ♦******«««*«******«#««#»«*«#««#*«««*t*«»«#*»«»###/04 16 fQ 1 


PROCEDURE IFCT.Y),. 






QA16 80 


DECLARE 






QA16 90 




FCT ENTRY RETURNS 






QA16 100 




(BINARY FLOATt, 


/«SINGLE PRECISION 


VERSION 


/*S*/0AI6 110 


/« 


(BINARY FLOAT (53)), 
(XX, Y) 


/•DOUBLE PRECISION 


VERSION 


/•D*/QA16 120 
QA16 130 




BINARY FLOATt 


/♦SINGLE PRECISION 


VERSION 


/*S*/0A16 140 


/• 


BINARY FLOAT (53», 
LY BINARY FLOAT (53)* 
I BINARY FIXED, 


/*00UeLE PRECISION 


VERSION 


/•D*/0A16 150 
QA16 160 
0A16 170 




X(32» BINARY FLOAT (53) 


STATIC INITIAL 




0A16 180 




(5.C77722 38 77537C8E+01, 


I.462135285476e32e-2Z 


, 


QA16 190 




'i.lC81666 52 5^912CE+0U 


I. 84634730730 3658E-18. 




QA16 200 




3.378197CA88226I7E+01, 


2.394688034185697E-15, 




QA16 210 




2.T83143e21132868E+01, 


8.4300 20422652a95E-13, 




QA16 220 




2.2e2130069352^21E+01, 


1,18665 8292679328E-10, 




0A16 230 




1.85 377431 786C669E*01, 


8. 197664329541 793E-09, 




QA16 240 




l.'.851'.3134180125E+01, 


3. 148 3 3 5585091 188 E-07. 




0A16 250 




l.l67 70 3367 39 75q6E*01, 


7.301 170259 124752E-06, 




QA16 260 




8.95 500 13 3772 33 qOE+00, 


1.08 3316812363997E-04, 




QA16 270 




6.642 21517974L'.'.^E«-00. 


1. 0725367310 55944E-03, 




QA16 280 




4. 70672 67076675 87EtOC, 


7.30978065330B856E-03, 




QA16 290 




3.1246C10 5C7 0214'.E+OC, 


3,51068 5 766314686E-02, 




0A16 300 




I,87 79315C7696074E+00, 


1.209162619118252E-01, 




0A16 310 




9.53b531553908655E-01, 


3. G2 53946 81 532850 E-Olt 




QA16 320 




3. 42200 1560 109477E-01, 


5. 5491628460 50598E-01. 




0A16 330 




3.796291457531345E-02, 


7,504767051856048E-01I 


,. 


0A16 340 


LY 


=0,. 

00 1=1 TO 31 BY 2t. 

XX =X(I),. 

LY =LYtX(!+l>*FCT(XX) 

END,. 






QA16 350 
0AI6 360 
QA16 370 
0A16 360 
0A16 390 


Y 


=LY,. 






0A16 400 


END. 


' 


/♦END OF PROCEDURE 


0A16 


*/QA16 410 



function values. This procedure must be 
supplied by the user. 



Usage 
FCT(X); 
FCT(X) - 

X- 



BINARY FLOAT [(53)] 
Resultant function value. 
BINARY FLOAT [(53)] 
Given argument value. 



BINARY FLOAT [(53)] 
Resultant integral value. 



Remarks: 



The n in the name QAn indicates the number of nodes 
used for the calculation of Y. 

Method: 



QA24.. 








QA24 10 


/«**»** 




Ktt*«««**«Ki**»**«*4rtt«***|i«»*********f***i|i/QA24 20 1 


/* 








*/0A24 30 


/* 


INTEGRATION OF A GIVEN 


FUNCTION BY ASSOCIATED 24 


-POINT 


♦/QA24 40 


/* 


GAUSSIAN-LAGUEPPE QUADRATURE FORMULA 




♦/0A24 50 


/* 








*/QA24 60 


/««*««« 


*******»*****t.*»***»in»****»*****^*************************»m***/QAZ^ 70 1 


PfiOCEDUOE tFCT,Y),. 






0A24 ao 


DECLARE 






QA24 90 




FCT ENTRY fiETUFNS- 






QA24 100 




(BINARY FLOAT), 


/♦SINGLE PRECISION 


VERSION 


/♦S^/0A24 110 


/* 


(BINARY FLOAT (53)>, 
(XX, Y) 


/♦DOUBLE PRECISION 


VERSION 


/*D^/0A24 120 
QA24 130 




eiNARY FLOAT, 


/♦SINGLE PRECISION 


VERSION 


/♦S*/QA24 140 


/« 


BINARY FLOAT (53», 
LY BINARY FLOAT (531, 
I BINARY FIXED,. 


/♦DOUBLE PRECISION 


VERSION 


/♦D^/QA24 150 
QA24 160 
0A24 170 


DECLARE 






0A24 180 




X(24) BINARY FLOAT(53) 


STATIC INITIAL ( 




QA24 190 




e.055628C8l995C41E+01 , 


6.906860197530437E+01, 




0A24 200 




6. 0206666963 05T22E+01, 


5.279543252728363E+01, 




QA24 210 




4. 63769795575401 3E*01, 


4.07ll59816554311Et01, 




'QA24 220 




3.565370351632821E*0l, 


3.1106464709C4657E*0l, 




QA24 230 




2.7C014C6C5647236E+01, 


2.328 793282487992E*01, 




QA24 240 




1. 99274258 7524246Et 01, 


1.68896719285 271 lE+01, 




QA24 250 




1,4150 5861872 85 76E+01, 


1.169069592605607E*01, 




QA24 260 




9.49409 53 30C26488E*00, 


7. 5477046 80023454E+00, 




QA24 270 




5. 840733271 323608E*0C, 


4.364283076935306E+00, 




QA24 280 




3.111052455147713E+00, 


2.075 11 290985238 lE+00, 




0A24 290 




1-25174C'632362746E«-0C, 


6.3 729G27 87 3266B8E-01, 




QA24 300 




2. 29102 31 64926243E-01t 


2. 54379965 8 568936E-02), 




0A24 310 


DECLAPE 






QA24 320 




W(24) BINARY FL0AT(53) 


STATIC INITIAL ( 




QA24 330 




1.58 711 C292154799E-35, 


1 .196922538662776E-30. 




QA24 340 




7. 3700721 60 301340E-27, 


1.112915493780457E-23," 




QA24 350 




6.376774647C10277E-21 . 


1.746C31920237335E-18, 




QA24 360 




2. 630 3192 45 3 1681 7E- 16, 


2.395179730958359E-14, 




0A24 370 




1.4CO386516309178E-12, 


5.630593075676338E-11, 




QA24 380 




1.56609 3499 3 30 76E-09, 


3.245G28271791540E-08. 




QA24 390 




4.93731 79B73395C1E-07, 


5.6945 17 38 3469 696E-06, 




QA24 400 




5.0 5719BC55 496 978E-05, 


3.5C3C086 36023457E-04, 




0A24 410 




1.9 127 846 ?96 3863 lE-03, 


8.3C60C98 23955105E-03, 




QA24 420 




2.888997 31499622CE-02, 


8. 09593 5396920 770E-02, 




QA24 430 




1.836445941585704E-01, 


3. 3 840894389 12822E-01, 




QA24 440 




5.C7923C853295182E-C1, 


6.220020607559262E-C1), 




QA24 450 


LY 


DO 1=1 TC 24,. 

XX =X(I),. 

LY =LYi-M(I)«FCT(XXl, 

END,. 






QA24 460 
QA24 470 
0A24 480 
QA24 490 
0A24 500 


Y 


=LY,. 






QA24 510 


ENOt 




/♦ENO OF PROCEDURE 


QA24 


♦/0424 520 



Purpose: 



/ e FCT(X) 



dX 



QAn computes the integral value Y = -j^ yx 
for a given function FCT(X), using associated 
Gaussian-Laguerre quadrature formulas. 

Usage: 

CALL QAn (FCT, Y); 



FCT - ENTRY 

Given procedure for the computation of the 



Quadrature formulas of Gauss- Laguerre are used 
for the evaluation of the integral value. 

For reference see: 

Concus, Cassatt, Jaehnig, Melby, "Tables for the 

Evaluation of q x'^ e f(x) dx by Gauss- Laguerre 
Quadrature, MTAC, vol. 17, No. 83 (1963), pp 245- 
256. 

Shao, Chen, Frank, "Tables of Zeros and Gaussian 
Weights of Certain Associated Laguerre Poly- 
nomials and the Related Generalized Hermite 
Polynomials", IBM Technical Report TR 00.1100, 
March 1964, pp. 15-16. 

Mathematical Background: 

Formulas of Gauss- Laguerre are used to compute 

y = fl^ dx 





Let n denote the number of nodes used for the 
calculation of the integral value y. 

The value y is approximated by a weighted smn of 
function values: 

y(n) . I ^^n) ^ ^^n) ^ 3 

The value y^ ^ is exact whenever f (x) is a poly- 
nomial of degree less than or equal to 2n-l. 

The nodes Xj^'^' are the roots of the associated 
Laguerre polynomials Lj^"-"-' ^)(x) of degree n. 
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Numerical Differentiation 



Remarks: 



Differentiation of Tabulated Functions 
• Subroutine DGT3 



DGT3.. 




DGT3 


IC 


/»m^t***1i»:t»'iim**»f* ******************** 


«<<«*«*«:«»****«*« *»««*>!< «««**«**« 


►«/DGT3 


20 


/* 




♦/DGT3 


30 


/* DIFFERENTIATE A TABLED FUNCTION USING LAGRANGIAN 


«/0GT3 


<tO 


/* INTERPOLATION FORMULA, DEGREE 


2 


♦/DGT3 


5C 


/* 




♦/DGT3 


60 


/4r««4^«4^%««;#«««««4«i*««##««^4:«««**««4L]K<' 




**/DGT3 


70 


PROCE0URE)X,Y,Z,DIM),. 




0GT3 


80 


DECLARE 




0GT3 


<)0 


(X(*),Y(*),Zl*) ,XA,X6,XC, 




0GT3 


ICC 


XBA,XCe.YA,YB,YC.QeA,OCB) 




DGT3 


lie 


BINARY FLOAT, 


/♦SINGLE PRECISION VERSION /*S*/OGT? 


120 


/» BINARY FL0AT(531, 


/♦DOUBLE PRECISION VERSION /• 


D«/0GT3 


13C 


(OIM.DBINARY FIXED, 




DGT3 


14C 


LERR CHARACTERU), 




0GT3 


150 


ERROR EXTERNAL CHARACTER( I ) , . 




DGT3 


16C 


IF DIM GE 3 


/*TEST SPECIFIED DIMENSION 


♦/DGT3 


170 


THEN DO, . 




0GT3 


180 


LERR ='0',. 


/»INIT. LOCAL EPFOP INDICATOR 


♦/DGT3 


190 


XB =X(3),. 




0GT3 


200 


Y6 =Y13),. 




0GT3 


210 


XC =X(1),, 




DGT3 


220 


YC =YU),. 




DGT3 


230 


XC8 =XB-XC, 




0GT3 


240 


IF XCB=C 


/*TEST MONOTONY OF ARGUMENTS 


♦/DGT3 


2 50 


THEN DO,. 




DGT3 


260 


LERR =•!•,. 


/*NON-HONOTONIC ARGUMENTS 


♦/0GT3 


27C 


XCB =1E-3C,. 


/♦CHANGE XCB TO I0**[-30) 


*/DGT3 


280 


END,. 




0GT3 


2Q0 


QCe =(Y6-YC(/XCB,. 


/•COMPUTE DIVIDED DIFFERENCE 


*/0GT3 


300 


DO I =2 TO DIM,. 




0GT3 


310 


OBA =QCB,. 


/♦SAVE DIVIDED DIFFERENCE 


*/DGT3 


320 


XBA =XCB,. 


/♦REPLACE XBA BY X 1 I-l )-X( I-2J 


*/0GT3 


330 


XA =XB,. 


/♦REPLACE XA BY xn-2) 


♦/DGT3 


340 


XB =XC,. 


/♦REPLACE XB BY XII-11 


♦/DGT3 


350 


XC =X(H,. 


/*SeT XC TO X(l» 


♦/DGT3 


360 


YA =Y6.. 


/♦REPLACE YA BY Y(I-2) 


♦/DGT3 


370 


VB =YC,. 


/*REPLACE Y6 BY Ytl-l) 


*/0GT3 


380 


YC = Y I n , . 


/♦SET YC BY Y(I1 


«/DGT3 


390 


XCB =XC-XB,. 


/♦REPLACE XCe BY X{I)-X(i-l) 


♦/DGT3 


400 


IF XCB*XPA LE C 




DGT3 


410 


THEN LERR =*1',. 


/♦MARK NQN-HONOTONIC ARGUMENTS 


♦/D&T3 


A20 


If XCB=0 




DGT3 


430 


THEN XCB =1E-3C,. 


/♦CHANGE XCB TO 1G*^(-301 


♦/0GT3 


440 


QCB =(YC-Y6)/XCB,. 


/♦COMPUTE DIVIDED DIFFERENCE 


*/DGT3 


450 


XA =XC-XA,. 


/♦REPLACE XA BY X(I)-XII-l) 


*/DGT3 


460 


IF XA=C 




DGT3 


47C 


THEN XA =lE-30,. 


/♦CHANGE XA TO IC^*(-3C) 


♦/DGT3 


480 


YA =(YC-YA1/XA,. 


/♦COMPUTE DIVIDED DIFFERENCE 


♦/DGT3 


490 


Zl I-l)=Qefl-YA*QCB,. 


/♦STORE DERIVATIVE VALUE Z(I-1)*/0GT3 


500 


END,. 




0GT3 


510 


ZIDIM)=0C6-QBA+YA,. 


/♦STORE DERIVATIVE VALUE ZtDIM)^/0GT3 


520 


END,. 




0GT3 


530 


ELSE LERR ='2S. 


/♦ERROR IN SPECIFIED DIMENSION 


♦/0GT3 


540 


ERROR=LERR,, 




0GT3 


550 


END,. 


/♦END OF PROCEDURE DGT3 


*/DGT3 


560 



Purpose: 

DGT3 computes a vector Z = {z-^, . . . , Zjji^) of 
derivative values, when vectors X = (xj, . . . , ^T-jjiyr) 
of argument values and Y = (y^^, y2, ... .y£)i]y[) of 
correspondii^ function values are given. 

Usage: 

CALL DGT3 (X, Y, Z, DM); 

X(DIM)- BINARY FLOAT [(53)] 

Given vector of argument values. 
Y(DIM) - BINARY FLOAT C(53)] 

Given vector of function values. 
Z(DM) - BINARY FLOAT [(53)] 

Resultant vector of derivative values. 
DIM - BINARY FIXED 

Given dimension of vectors X, Y and Z. 



If no errors are detected in the processing of data, 
the data indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERROR='l' means non-monotonic argument values; 
that is, for some i, (xj-xj.]^)* (Xj^^-j^-Xj) is 

less than or equal to zero. 
ERROR='2' means DIM is less than three. 

Vectors Z and Y may be identically allocated, 
which means that the given function values are re- 
placed by the resultant derivative values. 

Method: 



The resultant value z- is calculated as the derivative 
of the Lagrangian interpolation polynomial passing 
through points i-1, i, i+1, at argument x.. 



^i " -^i-l ^i+ 1 ^i ^i+ 1 ^i-1 
z. = + 



1 X. - X. , X. , - X. X. - - x. , 
1 1-1 1+1 1 1+1 1-1 



for i = 2, 3 DIM-1, and corresponding formu- 

lasforz^, Zj^jj^. 

For reference see: 



F. B. Hildebrand, Introduction to Numerical 
Analysis . McGraw-Hill, New York-Toronto- 
London, 1956, pp. 64-68. 

Mathematical background: 

For i = 1, . . . , n-2 we must find aj, bj, and c^ 
such that 



y.(x) = a.x + b.x + c. 
■'i^ ' 1 1 1 

passes through (x., y.), (x.^^, y.^^), and (x.^^- 

V2)- 

The desired derivative values z. are given by: 



r 



y'^(x^) =2a^x^ + b^ if i = 1 

z-= 1^ y.' i(x.) =2a. .X. +b. , if i = 2 n-1 

1 \ 1-1 1 1-1 1 1-1 



y^ 9^^^) = 2a „x + b if i = n 
V, n-^ n n-z n n-z 
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An easy computation yields: 



• Subroutine DET3 









^3 "-^2 



if i=l 



r{ 



^f^i-l ^i+l"^i Vl"^i-1 . 

+ - 



x.-x. , 
1 1-1 



X., ^ ""X, X, ^ X. ^ 

1+1 i 1+1 1-1 



if i = 2,... ,n-l 



+ ifi = n (1) 

X — X ^ X —X n ^ -I ~^ rt 

n n-1 n n-2 n-1 n-2 



Assumii^ that the vectors X and Y represent a por- 
tion of a three-times-differentiable function, z. in- 
volves a truncation error T. where: 

^l<W<Wy"'(^i) ifi=i 

■^i^ 6 ^''i'Vi^^Wi^y '" ^^i^ "'=^ °"^ 



- (x -X A(x -X -)y"' (4 ) if i = n 
^6 n n-2'^ n n-1" ^V 



and |. is in tiie closed interval determined by the 
three argument values used in computir^ z., i = 



Programming Considerations: 

The given table should represent a single-valued 
function. Non-monotonic arguments may cause du- 
bious derivative values. If any difference (xj-Xi_i), 
(x.^-j-xj), (Xi+i-xj_i) is zero, it is replaced by 10~30. 



0ET3.. 








0eT3 10 


/**«***»I«IK«»L« *«*««*« ****«*«*««]|11|I «!«**« 


* «****«*****«**« *4i***«****4iiii**«(i*/Qg1-3 20 1 










*/0ET3 30 




DIFFERENTIATE AN EOUIOI STANTLY TABLED FUNCTION USING 


•/DET3 *0 




LAGRANGIAN INTERPOLATION FORMULA, DEGREE 2 


*/DeT3 50 










•/0ET3 60 


/***»******» 


**v**#**********:*****»i»»»i*»****m*m*********************t**/0BJ3 70 1 


PRaCEOURECH,Y,Z,OIM),. 




DET3 80 


DECLARE 






0ET3 90 




IH,Y 


*) ,i(*),VA,YB,YC,HHI 




0ET3 100 




BINARY FLOAT, 


/•SINGLE PRECISION VERSION 


/•S^/DET3 110 


/* 


BINARY FL0AT(53) , 


/•DOUBLE PRECISION VERSION 


/•0*/DET3 120 




(DIM 


HBINARY FIXED, 




0ET3 130 




EOPOe EXTERNAL CHARACTER! I ), . 




06T3 140 


IF DIM GE 


3 


/♦TEST SPECIFIED DIMENSION 


•/DET3 150 


THEN 


DO,. 






0ET3 160 




IF H 


NE 


/•TEST SPECIFIED INCREMENT 


*/0ET3 170 




THEN 


DO,. 

HH =H+H,. 
YC =Y(l),. 
YA =YC-Y(2I,. 




DET3 180 
DET3 190 
DET3 200 
DET3 210 






YB =Y{3)+YA*-YA+YA,. 


/•MODIFICATION Y8 = VIO) 


*/0ET3 220 






00 I =2 TO DIM,. 




DET3 230 






YA =VB,. 


/•REPLACE VA BY VtI-2) 


*/DET3 240 






YB ^-YC*. 


/•REPLACE Yfl 6Y Y(I-U 


•/DET3 250 






YC =Y(I1,. 


/•SET YC TO Y(I( 


*/DET3 260 






Zn-l) = (VC-YA)/HHt. 


/•SET Z(I-l) TO (Y(I)-YtI-2)/2H*/DeT3 270 1 






END.. 




0ET3 280 






YC =YC-YB,. 




0ET3 290 






Z(0IH)=(YA-Y8+YC 


/*Z(0IM)*(Y(0IM-2)-4^YIDIH- 


1) •/DET3 300 






+YCtYC)/HH,. 


/**3*V(0IM))2^H 


•/0ET3 310 






ERRnR='0',. 


/•SUCCESSFUL OPERATION 


*/0£T3 320 






END,. 




DeT3 330 




ELSE 


ERR0R='1S. 


/•ERROR IN SPECIFIED INCREMENT •/DETS 3*0 | 




END, 






0ET3 350 


ELSE 


ERR0R='2S. 


/•ERROR IN SPECIFIED DIMENSION •/0ET3 360 | 


END, 






/•END OF PROCEDURE OETB 


*/DET3 370 



^dm) °^ 



Purpose: 

DET3 computes a vector Z = (z , z , . . 
derivative values, given a vector Y = (y , y^, 
yjjjjyf) of function values whose components y^ cor- 
respond to DIM equidistantly spaced argument 

2, ..., DIM. 



values x. with x. 
1 1 



■X. - = h for i 
1-1 



Usage: 



CALL DET3 (H, Y, Z, DM); 

H - BINARY FLOAT [(53)] 

Given increment of argument values. 
Y(DIM)- BINARY FLOAT [(53)] 

Given vector of function values. 
Z(DIM)- BINARY FLOAT [(53)] 

Resultant vector of derivative values. 
DIM - BINARY FIXED 

Given dimension of vector Y and Z. 



Remarks: 

If no errors are detected in the processing of data, 
the data indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 



ERROR='l' 
ERROR='2' 



means DIM is less than three, 
means H is equal to zero. 



Storage allocation for the vectors Z and Y may be 
identical, which means that the given function values 
are replaced by the resultant derivative values. 
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Method: 



The resultant value z- is calculated as the derivative 
of the Lagrangian interpolation polynomial passii^ 
through the points i-1, i, i+1 at argument x^. 



"i = ii<yi+i-yi-i)*°^^ = ''^' 



, DM-l 



and corresponding formulas for z , z-r-.^^^ 
For reference see: 



F. B. Hildebrand, Introduction to Numerical 
Analysis , McGraw-Hill, New York-Toronto-London, 
1956, pp, 82-84. 

Mathematical Background: 

The procedure is described under subroutine DGT3, 

but here we have the additional relation x. -x ,=h, 

1 i-1 

a constant, for i = 2, . . . , n. This leads to the 
following expression for z.: 



^k ^-h ^ ^^2 - 3^1) 



'-=(k^h+i-h-i^ 



v2l<'yn-%-l'-V2> 



if i = l 



if i = 2,...,n-l (1) 



if i = n 



€>0, the magnitude I Rj I of the corresponding error 
R. in the calculation of z- can be as large as: 



/- 



R. 



ii 
Ih| 



Ih| 



if i=l, n 



if i= 2 n-1 



Since small truncation errors generally require 
small I h I , while small roundoff errors generally 
require large | h | , it is reasonable to choose h so 
that] Til ^{Uil . 

If M = sup y'" (5), where £, e [x^, Xjj], and if 
we regard only the inner points X2, . . . .Xu-i* we 
find that 



h ,. fail. 

optimum 



'■\[7/M 



E. in z. is given by: 



and the magnitude E- of the total possible error 

1.1 ^v; 



3.3 ^\/e^M 



hH 



i\ 



if i=l, n 

if i = 2 n-1 



Assuming that the vector Y represents the 
function values of a portion of a three-times- 
differentiable function, z^ involves a truncation 



error Tj where: 



|- y'" (q). f^ e Cx^, Xg] ifi=l 



,2 
-h tit 



y (i), i, e [x ,, X -] if i = 2,...,n-l 

1 i l-X l+i 



yy"' (g.Cn^^V2'\^ "^=" 



In addition to these truncation errors, roundoff 
errors may be of considerable magnitude. Supposing 
that each of the ordinates y^ can be in error by ± c, 



Matiiematics — Differentiation of Tabulated Functions 109 



• Subroutine DET5 



DIFFERENTIATE AN EQUIOI STANTLY TABLED FUNCTION USING 
LAiiRANGIflN 1 NTFRPOLATION FORMULA, DEGREE 4 



CEDURe(H,V,Z,D!M) ,. 

LARE 

(H, Y(*) ,ZI«) ,YA,Ya.YC,YOiYE,HH) 
BINAPY FLOAT, / 

Bi-^ARY FLOAT! 53) , / 

(DIM, DBINARY FIXED, 
ECCOP EXTERNAL CHARACTER { 1 1 , . 



'SINGLE PRECISION VERSION 
■OOUBLE PRECISION VERSION 



«TEST SPECIFIED DIMENSION 



*TEST SPECIFIED INCREMENT 



=12*H,. 
= Y( L)/, 
=Y(2) ,. 

=Y(3l-yE,. 

=Y(^) ,. 

= Y( 5) 

*-5*(YD-YS+VA+YA) , . 

=5«(YC-YD+VE-Y0-YA1 

■t-Yf*,. 

DD I =3 TO DIM, . 



^MODIFICATION 



/♦MODIFICATION 



Y(OI 



vc 

YD 
YE 



= YE, 



ELSE 
END, 



Yd),. 
II r-2)=(YA-YE+ 

( Y0-YB)«8)/I 
END,. 
YA =YA-6*(YB-YC 

♦-YD-YC + YD-YCJ , . 
Z{D1V-Ii=( YE-YDt-YE-YD 

+Y?-YA)/HH,. 
?(DIM) = (Yfl + YA«-YA+Y 

■fYE-6*YCtl2»(YE 
-YD+YE-YC) )/HI 
ER»OR='0',. 
END, . 
ELSE &RR0R='1S. 
END, . 
FPR0R='2' , . 



Y9 



/0ET5 40 
/DET5 50 
/DET5 60 

DET5 80 

0ET5 90 

OETS 100 

/*S*/DET5 110 

/•0*/DeT5 120 

DET5 130 

0ET5 140 

*/DET5 150 

DET5 160 

»/DET5 170 

DET5 180 

DET5 190 

DET5 200 

DET5 210 

0ET5 220 

OeT5 230 

*/0ET5 240 

DET5 250 

*/0eT5 260 

DET5 270 

DET5 280 

*/DET5 290 

*/0ET5 300 

*/DET5 310 

*/DET5 32C 

*/DET5 330 

*/0ET5 340 

«/DET5 350 

DET5 360 

DET5 370 

DET5 380 

V0ET5 390 

*/0£T5 400 

0ET5 410 

0ET5 420 

DET5 430 

*/DET5 440 

0ET5 450 

/DET5 460 

0ET5 470 

/*ERROR IN SPECIFIED DIMENSION «/D6T5 480 

/*END OF PROCEDURE 0ET5 */DET5 490 



/♦REPLACE YA BY Y( 1-4) 
/"REPLACE YB BY Y( 1-3) 
/♦REPLACE YC BY Y(I-2) 
/♦REPLACE YD BY Y( I-l) 
/«SET YE TO YUl 
/*Z(I-2)=(Y(I-4)-Yl I}* 
,./*+8«(V(I-l)-Y(I-3))/12H 



/♦COMPUTE LAST TWO DERIVATIVE 
/♦VALUES 



♦SUCCESSFUL OPERATION 



♦ERROR IN SPECIFIED INCREMENT 



Purpose: 



DET5 computes a vector Z = (z^, Zo' * * ' ' '^BWO ^^ 
derivative values, given Y = (y^, y^, . . . , y^jM) of 
function values whose components correspond to 
DIM equidistantly spaced argument values x., with 



x.-x. 
1 1- 



= h. 



Usage: 

CALL DET5 (H, Y, Z, DIM); 



H 

Y(DIM) - 
Z(DIM) - 
DIM 
Remarks: 



BINARY FLOAT [(53)] 

Given increment for argument values. 

BINARY FLOAT [(53)] 

Given vector of function values. 

BINARY FLOAT [(53)] 

Resultant vector of derivative values. 

BINARY FDCED 

Given dimension o± vectors Y and Z. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 



ERROR^'l* means H is equal to zero. 
ERROR-'2' means DIM is less than five. 

Storage allocation for vectors Z and Y may be 
identical, which means that the given function 
values are replaced by the resultant derivative 
values. 

Method: 



The resultant value z. is calculated as the deriva- 
tive of the Lagrangian interpolation polynomial 
passing through the points i-2, i-l, i, i+1, i+2 at 
argument x.. 



^i " ^ ^^i+1 " ^i-1^ for i - 3, 4, ... , DIM-2 



1' 



and corresponding formulas for z , z , z 
z 12' DIM- 

DIM 

For reference see: 

F. B. Hildebrand, Introduction to Nimierical 
Analysis, McGraw-Hill, New York-Toronto- 
London, 1956, pp. 82-84. 

Mathematical Background: 



For i = 1, . . . , n-4 we must find a., b., c., d., and 
e. such that i i i i 

1 

__ 4 3 2 

y.(x) = a.x + b.x + c.x + d.x + e 
1 11111 

passes through (x.^j^, y._^|^) for k = 0, „ . . , 4. 
The desired derivative values z- are given by: 



— 3 2 

y^(x ) ^ 4a X. + 3b x. + 2c x. + d 

if i-l, 2 



if i = 3,...,n-2 



— 3 2 

y!, A (^•) =^^ A^- + 3b .X. + 2c ,x. + d , 
n-4 r n-4 i n-4 i n-4 i n-4 



V 



if i = n-l, n 
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Using the fact that x. - x. = h, a constant, for 
i=2,. .. ,n, we get: 

^ (-25y^ . 48j^ - 36y3 . 16y^ - Sy^) 

if i=l 



if i = 2 



h-< 



Iih<''i-2-»J'l-l**i+l-W 
if i = 3 n-2 



(1) 



■7:^ (-y . + 6y „ - 18y + 10 T + 3y ) 
12h ^ •'n-4 •'n-S •^n-2 n-1 -^n' 

if i = n-l 



—r (3y . -16y „ + 36y „ - 48y _ + 25y ) 
12h ^ •'n-4 •'n-3 •^n-2 •'n-l •'n' 

if i=n 



Assuming that the vector Y represents the func- 
tion values of a portion of a five-times-dlfferentiable 

function, z. involves a truncation error T. where: 
1 i 

T^X)' ^l^^V-5^ ''' = ' 

•l^y^)' ^2^^^1'V ^^ = 2 



T.= 
1 



j^4 

-^yX-i)'^-i^^V4'\^ "^='^-^ 

h* V 

— y (4 ), I e[x ^,x ] if i = n 
5 n n n-4 n 



Since small truncation errors generally require 
small j h I , while small roundoff errors generally 
require large | h | , it is reasonable to choose h so 
that I Tj I «^ I Ri |. 

If M = sup y^(4) 

and if we regard only the inner points X3, . . . , x^-2' 
we find that 



h ^. «:i2.1 

optimum 



^e/M 



and the magnitude I Ej I of the total possible error Ej 
in zj is given by: 



5 J 4 



u 



e M 



2.5 ^VeV 



^.4 ^Vf^M 



if i = 1, n 

if i = 2, n-1 

if i = 3, .. . , n-2 



In addition to the truncation errors, roundoff 
errors may be of considerable magnitude. Supposing 
that the ordinates y. can be in error by ± e, e > 0, 
the magnitude | Rj| of the corresponding error R. in 
the computation of z. can be as large as: 



r32c 



R. 



3|h| 

19e 
6|h| 

3e 

^2lh| 



if i ,= 1, n 

if i = 2, n-1 

If i = 3 n-2 
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Differentiation of Nontabulated Functions 
• Subroutine DFEC 













DFEC. 


t*****************^*,*^^,,^^^^ 


DFEC IC 


COMPUTE DERIVATIVE VALUE OF 


*/DFFC ^n 
A FUNCTION USING EXTRAPOLATION */nFPr in 


/* 


METHOD ON CENTRAL DIVIDED DIFFERENCES 


•/DFEC 50 


*** 


***********«*!<.**„****»^* 


t«****#w**«***#*###**^i4*^4^^ 


*/DFEC 60 


PRaCEDUSE(X,H,nPT»FCT,Z), . 

DECLARE 

tX,Z,H,HH,HK,V,LZ,Hl, 
DA,DB,DZ,AUX( 5) J 
eiNfiRY FLOAT, 


/♦SINGLE PRECISION VERSION 


RFFC 8C 
DFEC 90 
OFEC 100 
OF EC lie 
/♦S«/DFEC 12C 


/* 


61NARY FL0AT(53) , 


/*OOUBL£ PRECISION VERSION 


/«D«/DFEC 130 




IK 


MJBINARY FIXED, 




DFEC 140 




FCT ENTRY 
(BINARY FLHAT) 


/♦SINGLE PRECISION VERSION 


DFEC 150 

/*S*/OFEC 160 


/* 


(BINARY FLOAT(53J ) 


/•DOUBLE PRECISION VERSION 


/•C*/DFEC 170 




FETURNSIPINARY FLOAT), 


/•SINGLE PRECISION VERSION 


/•S*/DFEC leo 


/* 


RETURNSIBINARY FL0AT(53}1, 


/♦DOUBLE PRECISION VERSIPN 


/'0*/DFEC 190 




(ER 


POP EXTERNAL. 0PT)CHARACTER(1I,. 


DFEC 20C 


IF H 

THEN 


N€ 
DC, 





/*TEST SPECIFIED INTERVAL 


♦/DFEC 21C 
OFEC 22C 




HK, 


H1=A8S(H),. 


/*SET HI TO ABS(H) 


*/DFEC 2 30 




IF 


OPT NE -O' 


/♦SHOULD OPTIMUM STEPSIZE H 


♦/DFEC 24C 




THEN OD,. 


/♦BE GENERATED 


*/OFEC 250 






V =5E-1,. 


/♦SINGLE PRECISION VERSION 


/*S»/DFEC 26C 


/* 




V =5E-3,. 
IF HK GT V 


/♦DOUBLE PRECISION VERSION 


/*D*/DFEC 27C 
DFEC 280 






THEN HK =V,. 


/•SET HK =MIN(V,ABS(H) I 


*/DFEC 290 






DB =1 , . 




DFEC 300 






DA =AeS(FCT(X+HK) 




OFEC 310 






-FCT(X-HK) 1/2,. 




OFEC 320 






IF OA GT HK 




DFEC 33C 






THEN OB =0A/HK,. 


/*SET OB TO HAX(l,ABS(Tn 


♦/OFEC 340 






IF OA LT 1 




DFEC 350 






THEN OA =1,. 


/*SET DA TO MAXd.ABSIY) 


*/DFEC 360 






HK =V*DA/DB,. 




DFEC 370 






!F HK LT HI 




DFEC 38C 






THEN HI =HK,. 


/*SET HI TO MINIV*DA/DB,ABS(HI )*/OFFC 3<»0 | 






END, . 




DFEC 40C 




V 


=5, . 

00 K =1 TO 5,. 




DFEC 41C 
DFEC 420 






HK =(V/5)*H1,. 


/♦SET HK TO Hl*(6-K)/5 


♦/DFEC 430 






LZ,AUX(K)=(FCT(X+HK)- 


/♦SET AUX(K) TO T(0,K) 


♦/OFEC 440 






FCT(X-HK))/(HK+HK» 




OFEC 45 C 






HH =l/V,. 




DFEC 460 






HK =C,. 




DFEC 470 






DA =1E30,. 




DFEC 48C 






DO M =K-1 TO I flY - 


1,. 


DFEC 49C 






DB =DA, . 




DFEC 500 






HK =HK*HH,. 




DFEC 510 






DZ =(LZ-AUX1M) }/ 


/*SET OZ TO INCREMENT 


*/0FEC 520 






(HK«(2tHK)),, 




DFEC 530 






DA =A6SI0Z»,. 




DFEC 54C 






IF DB LT DA 


/♦TEST FOR OECR. INCREMENTS 


*/OFEC 550 






THEN GOTO NEWK,. 




DFEC 560 






LZ,AUX(M)=LZtDZ,. 


/*SET Z,AUX{M) TO T(K-M ,M) 


«/DFEC 570 


NEWK.. 




END, . 
V =V-1,. 




DFEC 580 
DFEC 590 








DFEC 600 




Z =LZ^* 

ERROR='0',. 
END, . 
ERRORS* I',. 


/•SUCCESSFUL OPERATION 


OFEC 610 

DFEC 620 

*/DFEC 630 


ELSE 
END, 


DFEf 640 1 
/•ERROR IN SPECIFIED INTERVAL */OFEC 650 1 







/♦END OF PROCEDURE DFEC 


♦/DFEC 660 



Purpose: 

Given the argument X and the function FCT(X), 
defined in the closed interval CX-|h| , X+ |H| ]. 
DFEC computes an approximation Z to the derivative 
of the function FCT(X). 

Usage: 

CALL DFEC (X, H, OPT, FCT. Z); 



X - 



BINARY FLOAT [(53) J 
Given argument value. 
BINARY FLOAT [(53)] 
Given radius of closed interval about X. 
OPT - CHARACTER (1) 

Given option for calculation of the stepsize. 

ENTRY 

Given procedure for calculating of function 

values, which must be supplied by the user. 



H - 



FCT 



Z - 



Usage: 

FCT(T) 

FCT(T) - BINARY FLOAT [(53)] 

Resultant function value. 
T- BINARY FLOAT [(53)] 

Given argument value. 
BINARY FLOAT [(53)] 
Resultant approximation to -^ FCT(X). 



Remarks: 

OPT = '0' means maximum stepsize is set equal to 
H; otherwise, it will be calculated within procedure 
DFEC (for details see "Mathematical Background"). 

If no errors are detected in the processing of 
data, the error indicator, ERROR, is set to zero. 
The following constitutes the possible error condi- 
tion that may be detected: 

ERROR = '1' means given H is equal to zero. 
Method: 

The approximation Z of tlie derivative is obtained by 
applying Richardson's and Romberg's extrapolation 
method to successively computed central divided 
differences, using function values in the closed 
interval [X-|h| , X+| h| ]. 

For reference see: 

S. Fillipi and H. Engels, "Altes and Neues zur 
numerischen Differentiation" , Elektronische 
Datenverarbeitung, iss. 2 (1966), pp. 57 - 65. 

Mathematical Background: 

Suppose, first, that y = y(t) is analytic at x; that is, 
y has a Taylor series expansion about the point x 
with radius of convergence R > 0. Let h be such 
that < I h I < R. For each positive integer n 
a step size h^ with < hj ^ | h | is computed as de- 
scribed below, and a sequence h^ of increments is 
generated, where 



\ 



k+ 1 



fork=2,. 



From the sequence (x-hj^, x+h^) of point pairs 
(k = 1, . . . , n) , the sequence of central divided 
differences 



0,k 



y(x+h^) -y(x-h, ) . , , 

k' k' fork = l n 



2h. 



(1) 



is computed, which forms the first column of the 
triangular Romberg scheme. The central divided 
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differences To,k represent the slopes of the secants 
sjj in Figure 2. 

tangent 




t=x-h 



y = y(0 



t=x+h 



1 . . . x-hc x+hc; . . . x=hi 



Figure 2. A sequence of secants for a given function y = y(t) and 
a given argument t = x for the case n = 5,h > 



If we also know Tq ^+2 we can generate 
"^l.k+l using equation (2), and further, we can com- 
pute the extrapolated value 



T -T 

T =T ^ l.k+1 ^l,k 

2,k ^l,k+l II 

^2,k 



where 



\k - " * n-(k+l) 



2 ,2 



which involves a truncation error of order h^ , 

Generally, the order of the truncation error is 
increased by 2 with each new extrapolation step; 
in particular, Tj . will involve a truncation error of 
order 



From the Taylor series expansions of y(x+hk) 
and y(x-h]j) it follows that 



"0,k 



2 4 

\ K 

= y'(x)+^y'"(x)+--fyV)+ ... 



for k=l n 



so that, as an approximation to y'(x), Tq k involves 
a truncation error of order h^ . ' 

Knowing the two divided differences Tq ^ and 
To,k+l. we are able to generate the extrapolated 
value 



u2i+2 . „ 

h ,1 = 0,..., n-1, j = 1, ..., n. 



Figure 3 shows the arrangement of the T values 
in the triangular Romberg scheme. The T values 
are computed following the upward diagonals, using 
the general formula: 



T -T 

T =T + "^~^»^^"i"'''l m-l,k-m 

m,k-m m-l,k-m+l m / ^ \ 

\'''^n-(k+l)/ 



n-(k+ 1) \ n-(k+ 1) , 



(4) 



for m = 1, . . . , k-1 for fixed k, k=2. 



T -T 

T = T 4. '^'k+l 0,k 

l,k ^0,k+l II 

a 
l.k 



where 



a^ , = (1 + -\) 2 
l,k n-k' 



1'l,k is a better approximation to y'(x) since 
l.k 

which involves a truncation error of order ht 



(2) 



Truncation 


^«.2. 


^^4> 


- 6 


8 


10 


error 


U(h^) 


0(hk) 


o(h^) 


0(h^) 


0<hk) 


Steps ize 


k\ 





1 


2 


3 


4 


\ 


1 


T„ , 


T, , 


T ) 


T 


T 


1 




0,1 


1,1 


2,1/ 


^^.1 


4.1 


h =0.8h. 


2 


T„ 


T J 


T I 


T 




2 1 




0.2 


'■H 


^2.2^ 


'3.2 




h2=0.6hj 


3 


\3/ 


>\ 


l\3 




^ 


h^=0.4h^ 


4 


\A 


T 
1.4 




^^ 


h =0. 2h, 


5 


T 






5 1 




0.5 


^^^^ 









Figure 3. The triangular Romberg scheme of T-values for the 
case n = 5 
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Numerical experience shows that the accuracy 
of the results depends heavily on roundoff errors in 
the central divided differences Tq j^. Therefore, 
the choice of the absolutely smallest step size, h^, 
is based on the following considerations. 
Let: 

1 in single-precision computation 

3 in double-precision computation 

— V I t 
h = min (n. 10 , | h |) 



h ="^<//'l'> .10-" 

n max(l, | T| ) 

Finally we set 

h, = min(n' h , hi) 
1 n ' ' 

guaranteeing that the evaluation of the function 
y = y(t) is restricted to the closed interval 
[x-l hi , x+ lh| ] . 

Programming Considerations: 



(5) 



(6) 



Set: 



Y= 7(y(x+hQ) + y(x-h^)) 



and 



T =-{y{x+h^) - y(x-hj^))/hj^ 



Y and T are approximations to y(x) and y'(x), 
respectively. 

Assuming that the errors in the function values 
y(t) for t f [x- 1 h I , x+ 1 h | ] are bounded by 



if |y|> 1 
if IyU 1 



formula (1) shows that the roundoff error in the com- 
putation of Tq XI is bounded by 




^Y.10-° 



^<Vn)=f=< 



10 



■D 



if I y| > 1 



if Y M 1 



V 



where D is the number of significant digits in the 
floating-point representation of numbers. Suppose, 
also, that we are willing to tolerate a roundoff error 



T'lO 



-D+v 



^•(^0,n) =' 



10 



-D+v 



if |t| > 1 
if |t| ^ 1 



Numerical experience shows that, because of in- 
creasing roundoff errors, it is generally fruitless 
to perform more than five extrapolations. Thus, 
the subroutine uses n = 5 , and it is therefore 
necessary only that y = y(t) be eleven-times dif- 
ferentiable, rather than analytic. It is easy to see 
that in the case n = 5, y = y(t) must be evaluated at 
twelve points in the closed interval [x-|h| , x+ |h| ]. 

As previously explained, tiie computation of the 
T values is performed along the upward diagonals 
of the triai^ular Romberg scheme. Therefore, 
only a one-dimensional internal storage vector, 
named AUX, with five storage locations is necessary. 
Figure 4 shows the storage administration and the 
sequence of computations (numbers in parentheses). 



AUX(l) 


\5<") 








AUX (2) 


\,i^) 


T, 4(12) 








AUX(3) 


^0.3^ 


^1.3<«> 


^2.3<^^) 






AUX (4) 


\2<2) 


^1.2<^) 


^2.2(^) 


^2'^") 




AUX (5) 


\l« 


T,i(3) 


^2.1<«> 


T3.1<^°> 


T,_,(15) 



Figure 4. Storage administration and order of computation 

Each extrapolation loop, the computation of the 
elements on an upward dij^onal, is terminated as 
soon as the absolute values of the differences be- 
tween adjacent diagonal elements stop decreasii^, 
showing the influence of roundoff errors. The com- 
puted T value that differs least in absolute value 
from its immediately preceding dis^onal neighbor is 
the desired value Z. 



Then we must have R(To q) ^^'CTq n)' ^^ich is 
satisfied when 
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• Subroutine DFEO 



DFFO. . 








OfEO 


10 


/*****♦ 


*«*****»:<.**<.** + *+*»** *«**♦:♦♦****»*»**»»*«**«»«««». #**.##!**** 


««• 


«*/DFEO 


20 


/* 








•/DFEO 


30 


/* 


COMPUTE DERIVATIVE VALUE OF 


A FUNCTION USING EXTRAPOLATION 


•/DFEO 


40 


/« 


METHOD fN ONE-SIDED DIVIDED 


DIFFERENCES 




♦/DFEO 


50 


/* 








*/DFEO 


60 


/*♦**** 


S««#««*iK«««V«L«W«««*»«*4:«*«««^«««i|i**«i«««i|i«««««4L«*« *«««««** 


*** 


*«/DFEO 


70 


PROCeOUR6(X,H,OPT,FCT,Z) ,. 






DFEO 


8C 


DECLAPE 






DFEO 


90 




(X,Z ,H,HK,HH, V.Y.HI , 






DFEO 


100 




DA,DB,D2,flUX( If)) 






DFEO 


110 




BILIARY FLOAT, 


/•SINGLE PRECISION VERSION 


/•S*/DFEO 


120 


/* 


PINAFY FL0AT(53) , 


/*OOUBLE PRECISION VERSION 


/« 


0*/OFEO 


130 




(K,M)HINARY FIXED, 






DFEO 


140 




FCT ENTRY 






DFEO 


150 




(BINAPY FLOAT) 


/*SINGLE PRECISION VERSION 


/• 


S^/DFEO 


160 


/« 


(BINARY FLOAT153)) 


/"DOUBLE PRECISION VERSION 


/* 


0*/OFEO 


170 




R£TURN5(BINARY FLOAT), 


/*SINGLE PRECISION VERSION 


/♦ 


S«/OFEO 


180 


/* 


PE:tuPNS(61NABY FLOAH53)), 


/•DOUBLE PRECISION VERSION 


/• 


D*/OFEO 


190 




(ERROR EXTERNAL,OPT)CHflRACTER(n,. 




DFEO 


200 


IF H 


NE 


/'TEST SPECIFIED INTERVAL 




•/DFEO 


21C 


THEN 


OO, . 






DFEO 


220 




Ml =H.. 






DFEO 


23C 




Y =FCT(X),. 






DFEO 


240 




IF OPT NE 'C 


/♦SHOULD OPTIMUM STEPSIZE HI 


*/OFEO 


250 




THEN DO,. 


/*BE GENERATED 




*/DFEO 


26C 




V =5E-1,. 


/•SINGLE PRECISION VERSION 


/• 


S*/OFEO 


270 


/* 


V =5E-3,. 


/•DOUBLE PRECISION VERSION 


/•Ot/DFEO 


280 




IF HI LT C 






DFEO 


290 




THEN V ==-V,. 






DFEO 


300 




IF ABS(V) GT ABS(Hl) 






DFEO 


310 




THEN HH =H1,. 


/•SET HH=SIGNtH)*MINlV,ABS( 


H)) 


•/DFEO 


320 




ELSE HH =V,. 






DFEO 


330 




06 =ABS( (FCT(XtHH) 






DFEO 


34C 




-Y)/HH),. 






OFEO 


350 




IF DB LT 1 






DFEO 


360 




THEN DB =1,. 


/•SET 06 TO MAX[l,ABSlT)) 




*/DFEO 


370 




HK =(VtV)/DB,. 






DFEO 


380 




IF ABS(Y) GT I 






DFEO 


39C 




THEN HK =HK*A6S(Y),. 


/•SET HK=2*V*HAX(1,ABS(Y1)/DB 


*/DFEO 


400 




IF ABS(HK) LT A8S{H1) 






DFEO 


410 




THEN HI =HK,. 


/•SET HI=SIGN(HJ*HIN(HK,ABS(H))*/OFEO 


420 




END,. 






OFEO 


430 




V =1C,. 






DFEO 


440 




DO K =1 TO 10,. 






DFEO 


450 




HK =(V/10)*H1,. 


/•SET HK TO Hl*( 11-KI/lO 




*/OfEO 


460 




Z,AUX(K)=(FCTIXtHK)-Y) 


/•SET AUX(K) TO T(0,K) 




*/DFEO 


470 




/HK,. 






DFEO 


480 




HH =1/V,. 






DFEO 


490 




HK =C,. 






DFEO 


500 




OA =1E3C,. 






DFEO 


510 




DO M =K-1 TO 1 BY 


-1.. 




OFEO 


520 




HK =HK+HH,. 






DFEO 


53C 




CZ =(Z-AUX(M)) 






OFEO 


540 




/HK,. 


/•SET OZ TO INCREMENT 




•/OFEO 


550 




OB =DA,. 






OFEO 


560 




OA =A6S(DZI,. 






DFEO 


570 




IF DB LT DA 


/•TEST FOR DECREASING INCReMENT*/DFEO 


580 




THEN GOTO NEMK.. 






DFEO 


590 




2,AUX(M)=ZtDZ,. 


/•SET Z,AUX{M) TO T(K-M,M1 




*/DF£0 


600 




END,, 






DFEO 


610 


^'RHK.. 








DFEO 


620 




V =V-1,. 






DFEO 


63C 




END, . 






DFEC 


640 




EPFO': = 'C',. 


/•SUCCESSFUL OPERATION 




*/DFEO 


650 




END, , 






DFEO 


660 


tLSE 


f i<»OR=« 1' , . 


/•ERROR IN SPECIFIED INTERVAL 


• /DFEO 


670 


END, 




/•END OF PROCEDURE DFEO 




*/0FEO 


680 



Purpose: 

Given argument X and function FCT(X), defined in the 
one-sided interval [X, X+H], DFEO computes an 
approximation Z to the derivative. 

Usage: 

CALL DFEO (K, H, OPT, FCT, Z); 



X 



H 



OPT 



FCT 



BINARY FLOAT [(53)] 

Given argument value. 

BINARY FLOAT [(53)] 

Given length of interval. 

CHARACTER (1) 

Given option for calculation of the stepsize. 

ENTRY 

Given procedure for calculation of function 

values, which must be supplied by the user. 



Usage: 

FCT(T) 

FCT(T) - BINARY FLOAT [(53)] 

Resultant function value. 
T - BINARY FLOAT [(53)] 

Given argument value. 
Z - BINARY FLOAT [(53)]] 

Resultant approximation to"^ — FCT(X). 

Remarks: 

OPT = '0' means maximum stepsize is set equal to 
H; otherwise, it will be calculated within procedure 
DFEO (for details see "Mathematical Background"). 

If no errors are detected in the processing of 
data, the error indicator, ERROR, is set to zero. 
The following constitutes the possible error condition 
that may be detected: 

ERROR = '1' means H is equal to zero. 

Method: 

The approximation Z of the derivative is obtained by 
applying Richardson's and Romberg's extrapolation 
method to successively computed one-sided divided 
differences, using function values in the closed 
interval [X,X+H]. 

For reference see: 

S. Fillipi and Engels, "Altes und Neues zur 
numerischen Differentiation", Elektronische 
Datenverarbeitung , iss. 2 (1966), pp. 57-65. 

Mathematical Background: 

Suppose, first, that y=y(t) is analytic at x; that is, 
y has a Taylor series expansion about the point x 
with radius of convergence R > 0. Let h be such 
that < I h I < R. For each positive integer n, 
a stepsize hi with <|hi| i |h| is computed as de- 
scribed below, and a sequence hj^ of increments is 
generated, where 

, n-k+1 , 

\ = —r-\ 

for k = 2, ... , n. 

From the sequence (x,x+h]j) of point pairs 
(k = 1, . . . , n), the sequence of one-sided divided 
differences 



0,k 



y(x+hj^) - y(x) 



for k = 1,... , n 



(1) 
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is computed, which forms the first column of the 
triangular Romberg scheme. These one-sided 
divided differences Tq j^ represent the slopes of the 
secants Sj^ in Figure 5 'in the case h > 0. 



which Involves a truncation error of order h? . 

If we also know Tg ^+2. we can generate 
Tl,k+1 using equation (2), and further, we can com- 
pute the extrapolated value 



SlW'. 




x+h]Q. . . x+h5. . . x+h 



Figure 5. A sequence of secants for a given function y = y(t) and 
a given argument t = x for the case n = 10,h > 



From the Taylor series expansion of y(x+hjj) it 
follows that 



h h^ 

for k = l, .. . , n 

so that, as an approximation to y'(x), Tq i^ involves 
a truncation error of order \. Knowing the two 
divided differences Tg jj ^^'^ Tq k+l» we are able 
to generate the extrapolated value 



T = T + 

l,k 0,k+l 



T -T 

0,k+l 0,k 

-1 



(2) 



where 



H.k=(^-^i^) 



T^ jj is a better approximation to y'(x) since 

\k 



i,k i,k 



T -T 

T = T + l.k+1 l,k 



2,k l,k+l 



a. 



2,k 



where 



^2,k ^^"^n-Oc+l) 



which involves a truncation error of order h^ . 

Generally, the order of the truncation error is 
increased by 1 with each new extrapolation step; in 
particular, T^j will involve a truncation error of 
order 



, i+1 

h. .1=0 n-1, j = 1, ..., n. 



Figure 6 shows the arrangement of the T values 
in the triangular Romberg scheme. The T values 
are computed following the upward diagonals, using 
the general formula 



T -T 

T =T + "^"l»k-m+l m-l,k-m 

m,k-m m-l,k-m+l m 



n-k+1 



for m = 1, . . . , k-1 for fixed k, k = 2 n 



(3) 



Truncation 
error 




0(hk) 


o(h5 


oo-k) 


0(h*) 


0(h5 


0(h^) 


Ofl.^) 


00.5 


00k) 


0(h'^ 


Stepsize 


^v m 
k \ 





1 


2 


3 


4 


5 


6 


7 


8 


9 




1 
2 


\2 


\2 


\l 
\2 


\l 
\2 


^■4.1 
\2 


\3 


^6,2 


^7,2 


\2 


\i 


h^=0.8hj 


3 


^0,3 


\3 


"•2.3 


\3 


\4 


\3 


'■'.a 




h^=0.7hj 


4 


\4 


\4 


\4 


J3.. 


\4 


\4 




h =0. 5h, 
6 1 

h^=0. 4hj 


5 
6 

7 


\5 
\7 


^5 
\7 


\7 


\5 
\7 




\5 


^ 


hg=0.3hj 


8 


^0,8 


\8 


\8 




hg=0. 2hj 


9 


\9 


\. 


y^ 


"lO-"-"-! 


10 


\io 


y 



















Figure 6. The triangular Romberg scheme of T values for the 
case n = 10 

Numerical experience shows that the accuracy 
of the results depends heavily on roundoff errors in 
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the one-sided divided differences Tq Jj. Therefore, 
the choice of the absolutely smallest step size, h.^, 
is based on the foUowii^ considerations. 
Let: 



guaranteeing that the evaluation of the function 

y = y(t) is restricted to the closed interval [x,x+h]. 

Programming Considerations: 



1 in sii^le-precision computation 
3 in double-precision computation 



Set: 



h^ = sgn(h)-min(|-10"^,|h|) 



T = (y(x+hQ) - y(x))/h^ 



T is an approximation to y'{x). 

Assuming that the errors in the function values 
y(t) for tf [x,x+h] are bounded by 



if |y(x)| > 1 
if I y(x) 1 ^ 1 



equation (1) shows that the roundoff error in the 
computation of Tq u is bounded by 




r 



^^\r) - W 



2|y(x)| 10"^ if|y(x)| > 1 
\\\ 



10 



■D 



if I y(x) 5 1 



where D is the number of significant digits in the 
floatii^-point representation of numbers. If we are 
also willing to tolerate a roundoff error 



2T-10 



-D+v 



R'(T„ ) = 



2-10 



-D+v 



if |T| > 1 
if |t[ 5 1 



we must have R(To^n) -R'(To,n)» which is 
satisfied when 



Numerical experience shows that, because of in- 
creasing roundoff errors, it is generally fruitless 
to perform more than ten extrapolations. Thus, the 
subroutine uses n = 10, and it is therefore 
necessary only that y = y(t) be eleven-times differ- 
entiable, rather than analytic. It is easy to see that 
in the case n = 10, y = y(t) must be evaluated at 
twelve points in the closed interval [x,x+h]. 

As previously explained, the computation of the 
T values is performed along the upward diagonals 
of the triangular Romberg scheme. Therefore, 
only a one-dimensional internal storage vector, 
named AUX, with ten storage locations is neces- 
sary. Figure 7 shows the storage administration 
and the sequence of computations (numbers in 
parentheses). 



AUX(l) 


^0,10<«' 






AUX (2) 


T„_,(37, 


T^_g(47) 






AUX(3) 


T„_3(29) 


y,,m) 


T2,8'«> 




AUX (4) 


T„_,(22) 


T,,(30) 


T,,(39) 




AUX (5) 


\r,"°> 


Tj,,(23) 


•^2,6'"' 




AUX(C) 


V5<"' 


^1,5'"' 


T2,5<^^' 




AUX (7) 


\,4<'> 


Tj ,,(12) 


^2,4<'8> 




AUX(8) 


V3'^> 


^1.3'«' 


T2,3<'^> 




AUX (9) 


To,2P' 


Tl.2<=> 


T,^,(9) 




AUX(IO) 


Vl<" 


T,,:<^' 


^2, l'"' 





T,3(53) 






T,2(44) 


^8,2<=^' 




T,_,(36) 


T3^,(45) 


T, j(55) 



Figure 7. Storage administration and sequence of calculations 

Each extrapolation loop, the computation of the 
elements on an upward diagonal, is terminated as 
soon as the absolute values of the differences be- 
tween adjacent diagonal elements stop decreasing, 
showing the influence of roundoff errors. The com- 
puted T value that differs least in absolute value 
from its immediately preceding diagonal neighbor 
is the desired value Z. 



^ max(l, |y(x)|) -v 
n max(l, |T|) 

Finally, we set 

hj - sgn(h)'min(n' Ih I, |h|) 



(4) 



(5) 
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Interpolation of Tabulated Functions 
• Subroutine ALIM/ALIE 



fiLIM., 






ALI 


10 


/**#»*» 


»************»*****»**♦#*****«**********«»*♦**♦*******. *»*♦**-•!.*/ AL I 


20 


/* 






*/ALI 


3C 


/* 


AITKEN SCHEME FOR INTERPOLATION OF FUNCTION VALUE 


*/aLi 


^C 


/* 


FROM GIVEN MnNPTONIC TABLE 




*/ALI 


50 


/« 






*/aLi 


60 


/3f***** 


>;(:***#**«:«:**«« *»*****t******Sft*«******* ********************** 


«/ALI 


70 


PROCEDURE IX,y,DIM,ORDER,EPS,XVaL,YVAL),. 


ALl 


8C 


DECLARE 




AL! 


9C 




(0IM,I,J,K,N,11,JL,JR,JJL,JJR 


DIMS, ORDER) 


ALI 


IOC 




BINARY FIXED, 




ALI 


Lie 




(X(*) ,Y(*I .flRG(MINIDI«,OR0ER) 


, VALI MINI DIM, OROER)).XVAL, 


ALI 


120 




VVAL,XST,OX,EPS,XS,Z1,Z2.D,OD 


VALI.VALU.A.OIST.OISTl, 


ALI 


130 




H,;)ELT1,0ELT2,FACT,ARG1) 




ALI 


140 




BINARY FLOAT, 


/*S1NGLE PRECISION VERSION /* 


S*/ALI 


150 


/* 


BINARY FLOAT 153) , 


/*OOUBLE PRECISION VERSION /« 


3*/ALl 


16C 




(ERR'^R EXTERNAL, SW) 




ALI 


170 




CHACACTEC (1),. 




ALI 


180 


SW 


= 'M', . 


/*MONOTONIC ARGUMENTS 


*/ALi 


190 


J 


= 1, . 




ALI 


20C 


D 


=1E75,. 




ALI 


210 




DO I = 1 TO OIM,. 


/*COHPUTE STARTING SUBSCRIPT J 


*/ALI 


220 




00 =AHS(XVAL-X(I)),. 




ALI 


23C 




IF 00 LE 




ALI 


2A0 




THEN 00,. 




ALI 


250 




=DD,. 




ALI 


260 




J =T ,. 




ALI 


270 




END, . 




ALI 


280 




END,. 




ALI 


290 


A.ARG! l) = X(Jl. . 




ALI 


300 


GO TO CCl,. 




ALI 


310 


ALie.. 






ALI 


320 






******************************* 


**/ALI 


330 


/* 






*/ALI 


3« 


/* 


AITKEN SCHEME FCR INTERPDLATI 


ON OF FUNCTION VALUE 


*/ALl 


35C 


/* 


FOQM GIVEN EQUIOtSTANT TAPLE 




*/ALI 


360 


/» 






*/ALI 


370 


/*****« 


*««***************«*********#« 


*******#****************»****** 


**/ALI 


380 


ENTPY lXST,DX,Y,OIM,ORLiEfi,ePS,XVAL 


.WAD , . 


AL 1 


390 


SM 


= 'F', . 




ALI 


-VCO 


Zl 


=XST,. 


/■^EOUIOISTANT ARGUMENTS 


*/AL [ 


AlO 


12 


=DX,. 




ALI 


A20 


J 


= 1,. 




ALI 


'^30 


A,ARG{ 1)=Z!,. 




ALI 


-VAC 


IF Z2= 




ALI 


A50 


THEN 


GO TO COM,. 




ALI 


460 


J 


=MAX1 1,IXVAL-Z1)/Z2H.5),. 


/*COMPUTE STARTING SUBSCRIPT J 


«/ALI 


470 


J 


=MIN(DIM.J) ,. 




ALI 


480 


A,ARG( ll = Zl+Ft-OAT( J-n*Z2,. 




ALI 


49 C 


CCM.. 






ALI 


500 


ERR0R='2' ,. 




ALI 


510 


XS 


=XVAL,. 




ALI 


520 


DIMS 


=011,. 




ALI 


530 


N 


=MIN(DIMS, ORDER) ,. 




ALI 


540 


DELT1,JL,JR=C,. 




ALI 


550 


VALIl.VAH 1) = Y(J) , . 




ALI 


56C 


FACT 


=XS~A,. 




ALI 


570 


0IST1=ABSIFACT),. 




ALI 


580 


N 


=MAX(N, I) , . 




ALI 


590 




00 I =2 TO N, . 


/*TA6LE SELECTION 


*/aLl 


600 




JJR =J+JR,. 


/*TEST IF SUBSCRIPT IS GREATER 


*/ALI 


610 




IF JJR GE DIMS 


/*THAN OIM OR LESS THAN ONE 


*/ALI 


620 




THEN GO TO LA82,. 




ALI 


630 




JJL =J-JL,. 




ALI 


640 




IF JJL LE 1 




ALI 


650 




THEN GO TO LAB3,. 




ALI 


660 




IF SW= 'E' 




ALI 


670 




THEN A =-FACT«Z2,. 


/♦A=tAPGfI-n-XVAL)*DX 


*/ALl 


680 




ELSE A =APS(X(JJR+1)-XS) 




ALI 


690 




-ABSIXI JJL-1)-XS),. 




ALI 


700 




IF A LE C 


/*TEST IF THE NEXT STEP IS TO 


*/ALI 


710 




THEN GO TO LA93,. 


/«THE RIGHT OR TO THE LEFT 


*/ALI 


720 


LflB2. . 




/*STEP TO THE LEFT 


*/ALI 


730 




JL =JL+1,. 




ALI 


740 




K =J-JL,. 




ALI 


750 




GO TO CONT,. 




ALI 


760 


LAB3. . 




/«STEP TO THE RIGHT 


*/ALI 


770 




JR =JR+1.. 




AL! 


780 




K =J«-JR,. 




ALI 


790 


CONT.. 


IF SW= •£• 




ALI 
AL! 


80C 
810 




THEN A =21+FLOAT(K-l)*Z2, 




ALI 


820 




ELSE A =X!K) ,. 




ALI 


830 




FACT =XS-A, . 




ALI 


840 




IF SW=*M' 




ALI 


850 




THEN DO,. 




ALI 


860 




DIST =A6SIFACT),. 




ALI 


870 




IF OIST LT OlSn 




ALI 


380 




THEN GO TO lOENT,. 


/♦ABGUMENTS NOT MONOTONIC 


*/ALI 


890 




01 ST1=0IST,. 




ALI 


900 




END, . 




ALI 


910 




ARG(I)=A,. 




ALI 


920 




VALI,VAL)I)=yiK).. 




ALI 


930 




DO II =1 TO 1-1,. 


/♦COMPUTE VALID 


*/ALI 


940 




ARGl =ARG(1I),. 




ALI 


950 




H =ARGI-A,. 




ALI 


960 




IF H =0 




ALI 


970 




THEN GO TO lOENT,. 




ALI 


980 




VALI =(VALnil*FACT-VALI 


ALI 


990 




*(XS-ARGI))/H,. 




ALI 


1000 




END.. 




ALI 


1010 




0ELT2=ABS(VALI-VALm ,. 




ALI 


1020 




VALIl,VALm=VALI,. 




ALI 


103C 




IF I GT 2 




ALI 


1040 




THEN 00,. 




ALI 


1050 




IF 0ELT2 LE EPS 


/*TEST ON ACCURACY 


*/ALI 


1060 




THEN GO TO STOP.. 




ALI 


1070 




!F I GE 5 


/*S1NGLE PRECISION VERSION / 


*S*/AH 


1080 


/* 


IF 1 GE 8 


/♦DOUBLE PRECISION VERSION / 


*0*/ALI 


1090 




THEN IF DELT2 GE DELTl 


/*TEST ON OSCILLATION 


*/ALI 


1100 




THEN GO TO OSCIL,. 




ALI 


1110 




END,. 




ALI 


1120 




DELT1=DELT2,. 




ALI 


113C 




END, . 


/*END OF AITKEN-LOQP 


• /ALI 


1140 


1 


=N, . 




ALI 


1150 


GO 


TO RETURN,. 




ALI 


1160 



OSCIL.. 




ALI 


1170 


EfiROR=*l*,. 




ALI 


1190 


GO TO IDENTl,. 




ALI 


1190 


IDENT.. 




ALI 


1200 


ERR0R='3',. 




ALI 


1210 


IDENTl.. 




ALI 


1220 


I =1-1,. 




ALI 


1230 


GO TO RETURN,, 




ALI 


1240 


STOP.. 




ALI 


1250 


9RR0R='C'.. 




ALI 


1260 


RETURN.. 




ALI 


1270 


YVAL =VAL( I ) .. 




ALI 


1280 


END.. 


/♦END OF PROCEDURE ALI 


*/ALI 


1290 



Purpose: 

ALIM interpolates the function value YVAL for a 
given argument value XVAL using a given table 
(X, Y) of argument and function values. 

Usage: 

CALL ALIM (X, Y, DM, ORDER, EPS, XVAL, 
YVAL); 



X - 



Y - 



DIM 



ORDER 



EPS- 



XVAL - 



YVAL 



Purpose: 



BINARY FLOAT [(53)] 

Given vector of monotonic argument values. 

BINARY FLOAT [(53)] 

Given vector of table-function values. 

BINARY FIXED 

Given dimension of vector X and Y. 

BINARY FIXED 

Given number of points to be selected 

out of the given table (X, Y) 

BINARY FLOAT [(53)] 

Given constant used as upper bound for 

the absolute error. 

BINARY FLOAT [(53)] 

Given argument to be interpolated. 

BINARY FLOAT [(53)] 

Resultant interpolated function value. 



ALIE interpolates the function value YVAL for a 
given argument value XVAL using XST, the starting 
value of the arguments, DX, the increment of tiie 
argument values, and the vector Y of function values. 

Usage: 

CALL ALIE (XST, DX, Y, DM, ORDER, EPS, 
XVAL, YVAL); 

XST - BINARY FLOAT [(53)] 

Given starting value of arguments. 
DX - BINARY FLOAT [(53)] 

Given increment of argument values. 
Y - BINARY FLOAT [ (53) ] 

Given vector of table-function values. 
DM - BINARY FIXED 

Given dimension of vector X and Y. 
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ORDER - BINARY FIXED 

Given number of points to be selected out 

of the given table (X, Y). 
EPS- BINARY FLOAT C(53)] 

Given constant used as upper bound for the 

absolute error. 
XVAL - BINARY FLOAT [(53)] 

Given argument to be interpolated. 
YVAL - BINARY FLOAT [(53)] 

Resultant interpolated function value. 

Remarks: 



argument next to the search argument XVAL is 
computed, using the foUowii^ formulas: 

In case of equidistant table - 

Subscript J = integer part of (-^ :=-^ + 1. 5) 

In case of monotonic table - 

Subscript J is searched for such that 

I XVAL - X(J) I s IxVAL - X(I) 1 , 1^1 ^DIM 



ERROR='0' - means required accuracy could be 
reached. 

ERROR='l' - means required accuracy could not 
be reached because of rounding 
errors. 

ERROR='2' - means accuracy could not be checked 
because MIN (DIM; ORDER) is less 
than 2, or the required accuracy 
could not be reached by means of 
the given table (X, Y). ORDER 
should be increased. 

ERROR='3' - means two arguments in the argu- 
ment vector X are identical, or the 
arguments are not monotonic. 

In case ERROR='0' and ERROR='2' the last inter- 
polated value for YVAL is returned. In case 
ERROR='l' and ERR0R='3' the value prior to the 
last interpolated value for YVAL is returned. H, 
by a user error, ORDER is greater than DIM, the 
procedure selects only a maximum table of DIM 
points. In order to avoid errors, the user should 
check the correspondence between the selected 
table and its dimension by comparison of DIM and 
ORDER. 



At each of the N = MIN (DIM, ORDER) interpola- 
tion steps, the procedure decides by comparison of 
distances whether the next step has to go to the right 
or to the left within the dimension of the given table. 

It is assumed that | X(I) - XVAL|>|X(J) - XVAL | 
for all I > J. Otherwise, ERR0R='3' is returned. 

yj means VAL(i); xj means ARG(i). 

Using the formulas 



^n = 



y. (x^ - XVAL) - y^ (x^ - XVAL) 

X - X, 
n 1 



and 



l,2,...,m,n= •'^1,2 m (x -XVAL) 



"•^l,2,...,m-l,n (x -XVAL) 

/(x -x ) 
n m 



it is possible to generate, by row, the followii^ 
triangular Aitken scheme: 



XjYl 



Method: 

Interpolation is done by means of Aitken's scheme of 
Lagrange interpolation. 

For reference see: 

F.B. Hildebrand, Introduction to Numerical Analysis , 
McGraw-Hill, New York-Toronto-London, 1956, 
pp. 49-50. 

Mathematical Background: 



^2 ^2 ^1,2 



^3 ^3 ^1,3 ■^1,2,3 



^4^4^1,4^1,2,4^1,2,3,4 



\^n^l,n^l,2,n^l,2,3,n • * 



All resultant values of row I are stored in VAL(i): 



Before startii^ Lagrange interpolation, a table 
(ARG, VAL) must be selected out of the given mono- 
tonic or equidistant table. This selection is done in 
two parts. In the first part, the subscript J of the 



VAL(i) = VAL(ii) • (XVAL - ARG(i)) 

- VAL(i) (XVAL - ARG(ii)) /( ARG(ii) - ARG(i)) 
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(ii= 1,2,.., 
ORDER). 



i-l)fori = 2, 3 MIN(DIM, 



Programming Considerations: 

The procedure stops under the following conditions: 

1. If the difference | (VAL(i-l) - VAL (i))|, with 
i s 3, of two successive values is less then a given 
tolerance EPS, ERROR='0' is returned. 

2. If the absolute value of this difference stops 
diminishii^, thus showing the influence of rounding 



errors, ERROR='l' is returned. (Test starts at 
step i = 5 for single precision, step i = 8 for double 
precision. ) 

3. If the procedure has worked through the whole 
triai^ular Aitken scheme, ERROR='2' is returned. 

4. If the procedure discovers that the arguments 
are not monotonic or that two arguments are identi- 
cal, ERR0R='3' is returned. 
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PROCEDURE ALIM USES AITKEN'S SCHEME FOR IMERPDLATinN IN GIVEN HONOION IC TABLE 
ENTRY AllE INTERFOLATFS IN EQUlDISiANT TABLE 



* * 

•PROCEDURE ALIH » 

« * 



• NARK ENTRY AHH* 

• SEARCH FIRST * 

• TABLE ENTRY • 

• (LINEAR SCAN I • 

• * 



*****CL **••**••** 



•SAVE INDEX J OF* 
• TABLE ENTRY » 



**•**«***«*••«•*• 



*»««*U1********«« 

• » 

• FETCH AND STORE* 

• CLOSEST • 

• ARGUMENT • 

• * 
*«••***«•**«•**«« 



***** E L********** 



PRESET 
ERROR- 'Z' 



***************** 



*****F1********** 

* * 

* COMPUTE MAXIMAL* 

* DIMENSION OF * 

* AITKEN SCHEME * 

* * 
***************** 



*«***G1********** 

* INITIALIZE JL * 

* AND JR (LEFT * 
*ANO RIGHT INDEX* 
*iTtPS IN TABLE)* 

* * 
***************** 



*«***HL*** ******* 

* INSERT FIRST * 

* FUNCTION VALUE * 

* IN AITKEN * 

* SCHEME * 

* * 
***************** 



*****J l**«**««*** 

* * 

* COMPUTE * 

* DIFFERENCE OF * 
*ARGUHENTS FACT » 

* * 
***************** 



**«**< l****$**«** 

* INITIALIZE » 
*CALCULAIION OF * 

* SUCCESSIVE *. 

* APPRO XIMANTS * 

* * 
***************** 



****A2 *♦***♦*♦• 

* * 

* ENTRY ALIE * 
« * 

***«*«*«•*«**** 



*****B2********** 

* * 
*MARK ENTRY ALIE* 
*CALCULATE FIRST* 

* TABLE ENTRY * 

* * 
***************** 



*****C2 ********** 



*SAVE INDEX J OF* 
* TABLE ENTRY * 



**«*4*4«****«*«** 



****«02********** 

* * 

* CALCULATE AND • 

* STORE CLOSEST » 

* ARGUMENT • 

* * 
*«4«««4*t**««4«** 



YE S . • WAS 

....*. ENTRY VI A 
*. ALIM 



*«***E 2 ********** 
KOMPLIE JJR THE* 

* INDEX OF NEXT * 
.X* RIGHT HAND 

* TABLE VALUE • 
» * 
****•«*••*«*« »*«« 



•X. 



F2 *. 

.»IS JJR *. 
. • HI THIN *. NC 
. SUBSCRIPT .*. .. 
*. RANGE .* 
*. . * 

♦. . * 
» YES 



*****G2********** 
*COMPUTE JJl THE* 
» INDEX OF NEXT * 
•LEFT HAND TABLE* 

• VALUE • 

* • 
***************** 



H2 *. 
. 'I S JJL *. 
NO . * M THI N • 
...*. SUBSCRIPT 

*. RANGE .« 



.*. 

J2 *. 
.* *. 

. * SHOULD *. NC 
. STEP BE TO .*. .. 
*. THE RIGHT.* 



♦•••*K2 **••••••** 

* UPDATE INDEX * 
*SIEP JR AND SET* 

.X* UP INDEX OF *. 

* NEXT TABLE « 

* VALUE * 
***************** 



84 •. 
.•IS NEW «. 

POINT *. NO 
CLOSER TO .*... 
. GIVEN .* 
•.XVAL .* 
♦ . .* 
* YES 



*****C4«* ♦♦****** 

• • 

• SET ERROR= •3' « 
.•(ARGUMENTS NOT •X. 

• MONOTONICI • 



*****^^ ********** 

• STHRE NErf • 

• ARGUMENT AND • 
.X* CnRRFSOONniNG » 

•FUNCTION VALUE • 

• ♦ 
««•***••*••*••*•* 



Yt^S . * ARE TWO *. 
....*. ARGUMENTS .< 
•.IDENTICAL.* 



«*•«••••••*•••*•• 



***** j-i********** 

* UPDATE INDEX * 
*STEP JL AND SET* 

.X* UP INDEX OF • 

* NEXT TABLE * 

* VALUE * 
•••««**********•• 



•••••K3***«^^**** 

* FETCH * 

• RESPECTIVELY • 
.X •CALCULATE NEXT • 

* ARGUMENT USED • 

• • 
••«**•**•*••*•*** 



. YES 
.•. 

F4 *. 

.* ARE *. 
NO .* FURTHER *. 
X..*. PniNTS 

•.AVAILABLE.* 

*. ,♦ 

•• .• 



. NO 
.*, 
G4 •• 

.» DOES *. 

.♦OSCILLATION*. 

*. INDICATE .• 

*. ROUND- .* 

*. OFF .* 



* YES 



*****Hit***** ***** 

* « 

* SET ERR0R='1> * 

* (ROUND OFF • 

* ERRORS) * 

* • 
••••♦•*•••***•**• 



*****J 4*^*^**«»** 

• • 

• RETURN • 
.X* INTERPOLATED *X. 

* VALUE YVAl * 

* • 
••••*•••«•**•••*• 



****K_it********* 
» END OF * 

•PROCEDURE ALIM • 

• * 

*************** 



*****0'i ********** 

* COMPUTE AND • 

* STORF NEW ROW ♦ 

* OF AITKFh » 

* SCHEME • 

* • 
••••••*••••««•*•* 



•••••E 5 ««*••••••« 

• CALCULATE • 

• niFFFRFNCF OF • 

• SUCCESSIVE • 

• INTERPOLATION * 

• VALUES * 
•«•••••*****•**** 



X 
.*. 

F5 *. 

. * AT *. 
NO . •LEAST THREE*. 
...*. POINTS .< 

*. USED .* 
, ♦ 



•, 



• YES 



G5 «. 
. * HAS ». 
NO . •niEFERENCE < 
...•. SMALL 

•. ENOUGH .< 
•. . • 



• YES 



•••••J5 ***♦**•••• 

• • 

• SET FRROR='0' * 
, * I SUCCESSFUL * 

*INTFRPOLATI CN) « 

• * 
*•••*•**•••••••*• 



••••*KS ••*•••**«* 

• * 

• CALCULATF * 

• ARGUMENT *. 
•niFFERENCE FACT* 

• • 
***************** 
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• Subroutine AHIM/AfflE 



AITKEN HERMITE SCHEME FOR INTERPOLATION OF FUNCTION VALUE 
FROM GIVEN MQNOTONIC TABLE 

PROCEDURE ( X, V, OY, DIM, ORDER, E PS, XVAL, WAD ,. 
DECLARE 

(DIM,DIMS,I ,ri,J,gJL,JJR,JL,JR,K,N,ORDER) 

eiNARY FIXED, 

lX(*),Y(*t,DY(*),ARG(HIN(DIM,0RDeRn,VAH2*HINIDlM,OR0ER)), 

EPS,XVAL,YVAL,XST,0X,A,O,DO,DELTl,DELT2,DIST,OISTl,H, 

Hl,H2,VALI,VALU,VALJ,VALJl,XS,Yl,YSt21,Z2) 



BINARY FLOAT, 

BINARY FLOAT (531 , 

(EROQF EXTERNAL, SW) 

rHABlTTERl l) , . 

-•M* ,. 

= 1. . 

=1F75,. 

00 I = I TO DIM,. 

DO =ABS(XtfAL-X(I ») ,. 

IF DO LE D 



/♦SINGLE PRECISION VERSION 
•DOUBLE PRECISION VERSION /*i 



/*MONOTONIC ARGUMENTS 



/•COMPUTE STARTING SUBSCRIPT J 



AMI 

♦ /AHI 
*/AHI 
*/AHI 

♦ /AHI 
*/AHI 
*/AHI 

AHI 
AHI 
AHI 
AHI 
AHI 
AHI 
AHI 

*/AHI 
0*/AHI 
AHI 
AHI 

*/AHI 
AHI 
AHI 

*/AHI 
AHI 
AHI 



THEN 00,. 




AHI 


250 


D =00,. 




AHI 


260 


J =1,. 




AHI 


270 


END,. 




AHI 


280 


END,, 




AHI 


290 


ARG( 1) = X( Jl,. 




AHI 


300 


GO TO COM,. 




AHI 


310 


AHIE.. 




AHI 


320 


/**«****»*ft««*ft*»ft**Be*a«»****«**»«* 


C«*«**********«#:»«**«>|,**:«>^*«*«*« 


•*/AHI 


330 


/* 




♦ /AHI 


340 


/* AITKEN HERMITE SCHEME FO^ INTERPOLATION OF FUNCTION VALUE 


*/AHI 


350 


/* FROM GIVEN EQUIDISTANT TABLE 




♦/AHI 


36C 


/* 




♦ /AHI 


370 


/«*«*»**:e***««**ft**««***<.«**«#***#** 


,««»*,**•*,«„♦*♦*♦*♦*« ft#««*t**««»,AHI 


380 


ENTRY (XST,0X,Y,0Y,D1M,0R0ER,EPS, 


KVALiYVALl ,. 


AHI 


390 


SW ='E',. 




AHI 


400 


Zl =XST,. 


/♦EQUIDISTANT ARGUMENTS 


♦/AHI 


410 


12 =DX,. 




AHI 


420 


J =1.. 




AHI 


430 


APG(1)=ZI.. 




AHI 


440 


IF Z2= 




AHI 


450 


THEN GO TO COM,. 




AHI 


46 C 


J =MAX( l,(XVAL-Zl)/Z2+I.51,. 


/♦COMPUTE STARTING SUBSCRIPT J 


♦/AHI 


470 


J =M!N(OIM, Jl,. 




AHI 


480 


ARG( ll = ZltFL0ATIJ-l)*Z2,. 




AHI 


49C 


COM.. 




AHI 


500 


ERR0R='2' , . 




AHI 


510 


XS =XVAL,. 




AH! 


520 


YS =YVAL,. 




AHI 


530 


DIMS =OIM,. 




AHI 


540 


N =HIN(0IMS, ORDER),. 




AHI 


55C 


JL,J«=0,. 




AHI 


560 


VALI,VAL(1)=Y(J»,, 




AHI 


570 


VAI.J,VAL(2»=DY(J},. 




AHI 


580 


H2 =XS-ARG(U,. 




AHI 


590 


0IST1=A9SIH21,. 




AHI 


600 


IF N LE 1 




AHI 


610 


THEN 00,. 




AHI 


62C 


IF N = I 




AHI 


630 


THEN VAL{1)=VAL( II+VAL1J)*H2 




AHI 


640 


ELSE VALn)=YS,. 




AHI 


650 


GO TO PETUCN,. 




AHI 


660 


END,. 




AHI 


670 


DO I =2 TO N,. 


/♦TABLE SELECTION 


*/AHI 


680 


JJR =JtJP,. 




AHI 


690 


IF JJP GE DIMS 




AHI 


70C 


THEN GO TO LA£J2.. 




AHI 


710 


JJL =J-JL.. 




AHI 


720 


IF JJL LE 1 




AHI 


7?C 


THEN GO TO LA83,. 




AHI 


740 


IF SW= 'E- 




AHI 


75 C 


THEN A =(A0GII-l)-XS)*Z2, 


/*A=(APG(I-1»-XVALI*DX 


♦ /AHI 


76C 


ELSE A =ASS(X(JJR*-l)-XS) 




AHI 


770 


-ABS(X(JJL-1I-XS»,. 




AHI 


780 


IF A LE C 




AHI 


790 


THEN GO TO LABS,. 




AHI 


800 


LAq2.. 




AHI 


81G 


JL =JL*U. 


/«STEP TO THE LEFT 


♦/AHI 


820 


K =J-JL,. 




AHI 


830 


GO TO CCNT. . 




AHI 


840 


LA33.. 




AHI 


850 


JR =JRtI,. 


/♦STEP TO THE RIGHT 


*/ftHI 


860 


K =J+JR,. 




AHI 


870 


CONT,. 




AHI 


680 


IF Sk= 'E' 




AHI 


890 


THEN A =Zl+FLOaT(K-l) «Z2, 




AHI 


900 


ELSE DO,. 




AHI 


910 


A =XU) ,. 




AH! 


92G 


DIST =ABS1XS-A),. 




AHI 


93C 


IF DIST LT OISTl 




AHI 


940 


THEN GO TO IDENT,. 


/♦ARGUMENTS NOT MONOTONIC 


♦/AHI 


95C 


DIST1=0IST,. 




AHI 


960 


END,. 




AHI 


970 


II =1+1,. 




AHI 


98C 


VALJ1=DYIK),. 


/*VALf2*Il=DY(K) 


♦ /AHI 


990 


VALU = Y(KI,. 


/♦VAL(2«I-11=YIK1 


*/AHI 


lOOC 


ARG( 1)=A, . 




AH! 


1010 


VAL(1I-3)=VALI+-VALJ*H2,. 




AHI 


1020 


HI =H2,. 




AHI 


1030 


H2 =XS-A,. 




AHI 


1040 


H =H1-H2,. 




AHI 


1050 


IF H = 




AHI 


1060 


THEN GO TO IDENT,. 


/♦TWO IDENTICAL ARGUMENTS 


♦ /AHI 


1070 


VALI ri-2)=VALI + (VALn 




AHI 


1C8C 


-VALI)*H1/H,. 




AHI 


1C9C 


VALI =VALI1,. 




AH! 


HOC 


VALJ =VALJ1,. 




AHI 


1110 


END,. 


/♦END OF TABLE SELECTION 


*/AHl 


1120 


VAL(II-11=VALI*VALJ*H2,. 




AHI 


1130 


DELT2=G,. 


/♦PREPARE AITKEN-SCHEME 


•/AHI 


1140 


Yl =VAH1),. 




AHI 


1150 


00 I = I TO N+N-2,. 


/♦START AITKEN-LOOP 


*/AH! 


1160 


YS =Y1,. 




AHI 


1170 


0ELT1=0ELT2,. 




AHI 


1180 


Hi =ARG((I*3)/2»,. 




AHI 


1190 



Yl =VAL(I*l),. 




AHI 


120C 


00 K = I TO 1 BY -1,. 




AHI 


1210 


H2 =ARG(IK+l)/2) ,. 




AH! 


1220 


H =H2-H1,. 




AHI 


1230 


IF H = 


/♦COMPUTE DIAGONALS OF AITKEN- 


*/AHI 


1240 


THEN GO TO lOENT,. 


/♦SCHEME 


*/AHI 


12 50 


Y1,VALIK)=1VAL(K)+(XS 


HI) 


AHI 


1260 


-Y1^US-H2))/H,. 




AHI 


127C 


END,. 




AHI 


1280 


DELT2=ABS(YS-Yn,. 


/♦TEST ON ACCURACY 


*/AH! 


129C 


IF 0ELT2 LE EPS 




AH! 


13CC 


THEN GO TO STOP,. 




AHI 


1310 . 


IF I GE 5 


/♦SINGLE PRECISION VERSION /♦ 


S^/AHI 


1320 


/♦ IF I GE 8 


/♦OOUBLE PRECISION VERSION /♦ 


D*/AHI 


1330 


THEN IF 0ELT2 GE DELTl 




AHI 


1340 


THEN GO TO OSCIL,. 




AHI 


1350 


END,. 


/♦END OF AITKEN-LOOP 


♦/AHI 


136C 


GO TO RETURN,. 




AHI 


1370 


PSCIL.. 


/♦DELT2 STARTS OSCILLATING 


*/AHI 


1380 


ERROR='l',, 




AHI 


1390 


VALI1)=YS,. 




AHI 


14C0 


GO TO RETURN,. 




AHI 


1410 


IDENT.. 




AHI 


1420 


VAL(1)=YS,. 




AHI 


143C 


ERR0R='3',. 




AH! 


1440 


GO TO RETURN,. 




AHI 


1450 


STOP.. 




AHI 


1460 


ERROR='0',. 




AHI 


1470 


RETURN.. 




AHI 


1480 


YVAL =VAL(1),. 




AHI 


1490 


END,. 


/♦ENO OF PROCEDURE AHI 


♦ /AHI 


1500 



Purpose: 

AHIM interpolates the function value YVAL for a 
given argument value XVAL using a given table 
(X, Y, DY) of argument values, fimction values, and 
their derivatives. 

Usage: 

CALL AHIM(X, Y, DY, DIM, ORDER, EPS, XVAL, 
YVAL); 

X - BINARY FLOAT [(53)] 

Given vector of monotonic arguments. 
Y - BINARY FLOAT [(53)] 

Given vector of table-function values. 
DY - BINARY FLOAT [(53) ] 

Given vector of derivative values. 
DIM - BINARY FIXED 

Given dimension of vector X, Y, DY. 
ORDER - BINARY FIXED 

Given number of points to be selected 

out of the given table (X, Y, DY). 
EPS - BINARY FLOAT [(53) ] 

Given constant used as upper bound 

for the absolute error. 
XVAL - BINARY FLOAT [(53) ] 

Given argument to be interpolated. 
YVAL - BINARY FLOAT [(53) ] 

Resultant interpolated function value. 

Purpose: 

AHIE interpolates the function value YVAL for a 
given argument value XVAL using XST, the start- 
ing value of the argument, DX, the increment of 
the argument values, vector Yof the function 
values, and vector DY of the function derivative 
values. 
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Usage: 



Method: 



CALL AfflE (XST, DX, Y, DY, DIM, ORDER, EPS, 
XVAL.YVAL); 

XST - BINARY FLOAT [(53) ] 

Given starting value of the arguments. 

DX - BINARY FLOAT [(53) J 

Given increment of the argument 

values. 
Y - BINARY FLOAT [(53)] 

Given vector of table-function values. 
DY - BINARY FLOAT [(53) ] 

Given vector of function derivative 

values. 
DIM - BINARY FIXED 

Given dimension of the vector X, Y, 

DY, 
ORDER - BINARY FIXED 

Given number of points to be selected 

out of the given table (X, Y, DY). 
EPS - BINARY FLOAT [(53) ] 

Given constant used as the upper 

bound for the absolute error. 
XVAL - BINARY FLOAT [(53)] 

Given argument to be interpolated. 
YVAL - BINARY FLOAT [(53) ] 

Resultant interpolated function value. 

Remarks: 

ERROR='0' means required accuracy could be 

reached. 
ERROR='l' means required accuracy could not be 

reached because of rounding errors, 
ERROR='2' means accuracy could not be checked 
because MIN(DIM, ORDER) is less 
than 2, or the required accuracy 
could not be reached by means of the 
given table (X, Y, DY). ORDER should 
be increased, 
ERROR='3' means two arguments in argument 

vector X are identical or the arguments 
are not monotonic. 
In the case ERROR='0' and ERROR='2' the last 
interpolated value of YVAL is returned. The value 
prior to the last interpolated value for YVAL is 
returned. 

If, by a user error, ORDER is greater than DIM, 
the procedure selects only a maximum table of DIM 
points. In order to avoid errors, the user should 
check the correspondence between the selected 
table and its discussion by comparison of DIM and 
ORDER. 



Interpolation is done by means of Aitken's scheme 
of Hermite interpolation. 

For reference see: 

F. B. Hildebrand, Introduction to Numerical Analy- 
sis , McGraw-Hill, New York-Toronto-London, 
1956, 11. 314-317. 

Gershinsky and Levine, " Aitken- Hermite Inter- 
polation" JACM, vol. 11, issue 3 (1964), pp. 352- 
356. 

Mathematical Background: 

Before starting Hermite interpolation, a table (ARG, 
VAL) must be selected out of the given monotonic or 
equidistant table. This selection is done in two 
parts. In the first part, the subscript J of the argu- 
ment next to the search argument XVAL is computed, 
using the following formulas: 

In case of the equidistant table - 

Subscript J = the integer part of 

( XVAL-XST + 1.5) 
DX 

In case of the monotonic table - 

Subscript J is searched for such that 

I XVAL - X(J) I < I XVAL - X(I) | , 1 s I s DIM 

At each of the N = MIN(DIM, ORDER) selection 
steps, the procedure decides, by comparison of 
distances, whether the next step in vector X has to 
go to the right or to the left within the dimension of 
the given table, and replaces the components of 
vector VAL (that is, function and derivative values) 
by interpolation values Zj of the first order (see 
Figure 8, third column). This is done by the 
following formulas: 



VAL(i) = y. + VAL (i + 1) • HI (1=1,3, 



, , 2n-l) 



HI 



H1-H2 



VAL(i+l) = y^+ (VAL(i+2) - y) 

2n-3) 
with 



n= MIN(DIM, ORDER), y. = VAL(i) 



(i=l,3,, 
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HI =■■ XV AL - ARGG-l), H2 = XVAL - ARG(j) 



and 



Now it is possible to generate successively the 
upward diagonals of the triangular Aitken scheme, 
using the following formulas: 



z X - XVAL 



1,2 Xg-x^ 



2,3 Xg-Xj 



1,2,3 Xg-Xj 



^'^ V^2 



z„ X, - XVAL 
2 1 

Zg Xg - XVAL 



z^^gXj-XVAL 
^3'^2-™^ 



Zg Xg - XVAL 
z^ Xg-XVAL 



with 

x.= ARG(i). 

All resultant values of an upward diagonal can be 
stored in positions of vector VAL with decreasing 
subscripts: VAL(k) = 

VAL(k) • (XVAL - HI) - VAL(k+l) • (XVAL -ARG(1)) 
ARG(l) - HI 

for 

J =1. 2 i, 

where 



. . , ri+3l 

= 1-3+1, m=L— J, 



^ = [-^] 



and HI = ARG (m) 

for i= 1, 2 2n-2. 



ARG(l) = Xj 


VAL(l) = yj 


VAL(l) = Zj 


^1.2 


""1,2,3 


'l.2,3,4" 




VAL(2) = y>^ 


VAL(2) = z^ 


\z 


''2,3,4 




ARG(2) = x^ 


VAL(3) = y^ 
VAL(4) = y'2 


VAL(3) = Zg 
VAL(4) = z^ 


'3,4 


'3,4,5 




ARG(n) = x^ 


VAL(2n-l) = y 
VAL(2n) = y'^ 


VAL(2n-l) 
= ^2n-l 


• 







Figure 8. Triangular scheme for Aitken-Hermite interpolation 



Programming Considerations 

The procedure stops under the following conditions: 

1. If the absolute value of the difference between 
two successive interpolated values VAL(l) is 
less than a given tolerance EPS, ERROR='0' 
is returned. 

2. If the absolute value of this difference stops 
diminishing (thus showing the influence of 
roimding errors), ERROR='l' is returned. 
(Test starts at step i = 5 for single precision, 
i = 8 for double precision. ) 

3. If the procedure has worked through the whole 
triangular scheme, ERROR='2' is returned 
(see "Remaiks", above). 

4. If the procedure discovers two table points 
with identical arguments or the arguments are 
not monotonic, ERROR='3' is returned. 



124 Mathematics — Interpolation 



PROCEDURE 4HIH USES 41 TKE NMHE RHI IE SCHEKE FHR INTERPOLATION IN GIVEN MDNOTONIC T4BIE 
ENTRY 4H1E INTERPOLATES IN EQUIDISTANT TABLE 



**** A 1*** ****** 
« * 

•PKuCcOURE AHIM * 
* * 

*************** 



*****tj I*** ******* 

* NAKK ENIKV » 

* AHIM, SEARCH * 

* FIRST TABLE * 

* ENTRY (LINEAR » 

* iCAN ) ♦ 
**•*««*•**«»**«*« 



*****L I********** 



•SAVE INDEX J OF* 
• TABLE ENTRY » 



«***««**«««**««*« 



*****J 1********** 
« * 

♦FETCH AND STORE* 

• CLOSEST • 

* ARGUMENT • 
« * 
***************** 



**««A2********* 

* * 

* ENTRY AHIE » 

* * 
•«««*«******««* 



****«B2*******«** 

* MARK ENTRY • 
•AHIE, CALCULATE* 

* FIRST TABLE » 

* ENTRY » 

* • 
•*«*44**«4*«***** 



***«*C2********** 



*SAVE INDEX J OF* 
• TABLE ENTRY » 



****«*««««******* 



*****02 ********** 

* * 

* CALCULATE AND * 

* SICRE CLOSEST * 

* ARGUMENT • 

* * 
***************** 



***** el*** ******* 



PRESET 
ERR0R=<2' 



***************** 



**»**F I*** ******* 

* * 
*COMPUTE MAXIMAL* 

* DIMENSION OF * 
*AITKtN SCHEME N» 

* * 
*«««******«**«*** 



**«**Gl*** ******* 
» INITIALIZE JL * 

* AND JR (LEFT * 
*AND RIGHT INDEX* 

* STEPS IN TABLEI* 

* * 
•«*««**««******** 



• ♦***HI ********** 
» INStRT FIRST • 

• FUNCT ION AND • 

• UtRlVATIVt * 

• YALUt IN AITKEN* 

• SCHEME • 
****«****«****»«« 



****«J I********** 

* * 

* COMPUTE * 

* DIFFERENCE OF * 

* ARGUMENTS H2 * 

* * 
***************** 



.•DIMENSION N*. YES 
*. GREATER THAN .*... 
*. ONE .* 



F2 *. 

.• HAS «. 

.*TABLE STILL*. NC 

.X*. VALUES TO .*... 

•. RIGHT .• 

*. . • 

♦. . • 

YES 



F2 •. 
.• HAS •. 

NO .•TABLE STILLS. 
,..*. VALU(;S TO . 
*. LEFT .« 
*. . * 

*. .* 
YES 



. • *. 

. • SHOULD *. NC 
. STEP BE TO .*..) 
*. THE RIGHT.* 



•****H2 *****•**•* 

* UPDATE * 

* INDEX-STEP JR * 
. X* AND SET UP * 

*INDEX OF TABLE * 

* VALUES * 
******4**««*****« 



*****J2 ********** 

* UPDATE * 

* INDEX- STEP JL • 

* AND SET UP *X. 
*INOEX OF TABLE • 

* VALUES • 
****••*♦********♦ 



***** A3* ********* 

* FETCH » 
» RESPECT IVELY • 
*CALCULATE NEXT *. 

* ARGUMENT USED • 

* * 
***************** 



.• HAS •.NO 

». FN TRY VIA .*. .. 
*. AHIM .* 



B4 *. 
.*IS NEW *. 
• PRINT *. NO 

CLOSER Td .*. .. 
*. GIVEN .* 
*.XVAL .* 
♦ . .* 
• YES 



K2 



•- 



.* IS ». YES 

.X*. DIMENSION N .*.... 
*. EQUAL ONE.* 
*. . * 

*. . * 
* NO 



*****K3********** 

* * 

* CALCULATE * 
.X* INTERPOLATED *. 

* VALUE • 
> * 
•*•*******«*****« 



*****D4*«******^* 

* * 

• SET ERR0R*'3' » 
.•(ARGUMENTS NOT •X. 

• MONHTONIC) » 

* • 
••****•****•«*•** 



««***B 3 **••***••* 
•STORE ARGUMENT • 

• AND VALUES OF • 
. X» FUNCTION AND * 

• OFRIVATIVE • 

• • 
***************** 



*****C 5 *****«**•« 

• CALCULATE AND • 

• STORE • 

• INTERPCLATICN • 

• VALUFS OF FIRSTS 

• ORDE R • 
*********«••••••* 



YES .* ARE TWO *. NO 
...... ARGUMENTS .*... 

•.IDENTICAL.* 



••••*E4^* •*••*•*« 

• INITIALIZE • 
•CALCULATION OF • 

• DIAGONALS IN •X. 

• AITKFN SCHFMF • 

• • 
*****«***«*«»**** 



****F4***^^***** 

* 

CALCULATE • 

CURRENT •X 

DIAGONAL • 

• 

**•*••**••**•*•• 



. NO 
. *. 
E5 *. 

. ♦ ARE ». 

YES . * ENOUGH *. 

.... •.TABLE POINTS .'X. 

•.SELECTED .• 

•. . • 

*. . • 



•••••F5^**^*****^ 

* * 

* PREPARE • 
. *CALCULATION OF * 

* NEXT DIAGONAL • 



*****G 4* ******•*• 

• CALCULATE • 

• DIFFERENCE OF • 

• SUCCESSIVE * 

• INTERPOLATION * 

• VALUES • 
********•**•*•**• 



H4 *. 

.* HAS *. 
.*DIFFERENCE *. NO 
*. SMALL .*. .. 

*. ENOUGH .* 
*. .* 



***************** 



NO 
. *. 
G5 *. 

.* FULL *. 
. * AITKEN *. YES 

SCHEME .*... 

*. COMPUTED .* 
*. . • 



. NO 
. •. 

H5 •. 

. • DOES •. 

. •nSCI LLATI CN^. 

. INDICATE 

•.ROUND- OFF. • 

•. . • 



• YES 



*****J4*****«**** 

* * 

* * 

* SET FRROR='0» • 

* * 

* * 
***************** 



YES 



***«*J5 ********** 

* * 

* * 

* SET FRROR='l ■ * 
« * 

* * 
***************** 

'.X 



*****<4«******** 
* 

* RETURN 
.X* INTERPOLATED 

* VAL UE 

* « 
***************** 



**«*K5«*«*****« 

* END OF * 

* PROCFDURF * 

* AHIM/AHie * 
*************** 
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• Subroutine ACFM/ACFE 



ACFH.. 




ACFI 10 


/*********»*****#*#»********^>#*m»t**m***0^m********it»m**»*******»i**9**/ACfl 20 1 


/* 




♦/ACFI 30 


/* CONTINUED FRACTION SCHEHE FQfl 


INTERPOLATION OF FUNCTION 


VALUE*/ACFI 40 


/* FROM GIVEN MONOTONIC TABLE 




•/ACFI 50 


/• 




•/ACFI 60 


/»**t***tr****t******************m*m** 


*******m*****ii*m****m****m**m****//^CfI 70 1 


PROCEDURE ( X, Y, DIM, ORDER, EPS, XVAL, 


YVAL),, 


ACFI eo 


DECLARE 




ACFI 90 


(0!M,I,J,K,N,II,III,JL,JR,JJL 


,JJR, DIMS, ORDER) 


ACFI 100 


BINARY FIXED, 




ACFI 110 


(X(*),Y(»),ARG(MINIOIM, ORDER) ),VAL(MINCDIH,OR06R>>,XVAL, 


Al. ACFI 120 


YVAL,XST,0X,EPS,XS,Z1,Z2,D,D0 


,VALI,ARGI»A,0IST,0IST1.H,DELT1, ACFl 130 1 


DELT2,ARGJ,P1,P2,P3,QI,Q2,Q3. 


ZS.YS.ARGIl.VALIl.EPSl) 


ACFI 140 


BINARY FLOAT, 


/•SINGLE PRECISION VERSION 


/•S*/ACFI 150 


/« BINARY- FLOAT (531, 


/•DOUBLE PRECISION VERSION 


/*D*/ACFI 160 


(ERROR EXTERNAL. SM) 




ACFI 170 


CHARACTER (It.. 




ACFI 180 


SH ='M',. 


/♦MONOTONIC ARGUMENTS 


•/ACFI 190 


J =1,. 




ACFI 200 


=1E75,. 




ACFI 210 


DO I = I TO DIM., 




ACFI 220 


DO =ABS(XVAL-X(I»),. 




ACFI 230 


IF DO LE D 




ACFI 240 


THEN 00,. 




ACFI 250 


=DD,. 




ACFI 260 


J =1.. 




ACFI 270 


END,. 




ACFI 280 


END,, 




ACFI 290 


ARGI,ARG(1I=.X( J),. 




ACFI 300 


60 TO COM.. 




ACFI 310 


ACFE.. 




ACFI 320 


/**************«*#v»m##************»9*»»**ti******9*9******************/f^fl 33d 1 


/* 




♦/ACFI 340 


/* CONTINUED FRACTION SCHEME FOR 


INTERPOLATION OF FUNCTION 


/ALUE*/ACFI 350 


/* FROM GIVEN EQUIDISTANT TABLE 




•/AC FT 360 


/* 




•/ACFI 370 


/*«««*««********«*«««*««*««**«***«««« 


***»*$:mm********'^***m****»****t**//^cf^ 380 1 


ENTRY ( X ST, DX,Y, DIM. ORDER, EPS,XVAL 


.YVAL),. 


ACFI 390 


SH =•£',. 




ACFI 400 


21 =XST,. 




ACFI 410 


ZZ =0X,. 




ACFI 420 


J =1,, 




ACFI 430 


ARGI,ARG(i)=Zl,. 




ACFI 440 


IF Z2= 




ACFI 450 


THEN GO TO COM,. 




ACFI 460 


J =MAX(l,(XVAL-Zl)/Z2+1.51,. 


/•COMPUTE STARTING SUBSCRIPT J */ACFI 470 1 


J =MIN(DIM,JI,. 




ACFI 480 


ARGI,ARG{ 1)=ZI+FL0ATIJ-1)*Z2,. 




ACFI 490 


COM.. 




ACFI 500 


PPSl =1^-6,. 


/•SINGLE PRECISION VERSION 


/•S^/ACFI 510 


/*EPSl =IE-13.. 


/•DOUBLE PRECISION VERSION 


/•O^/ACFI 520 


eRR0R=*2',. 




ACFI 530 


XS =XVAL,. 




ACFI 540 


DIMS =DIM,. 




ACFI 550 


N =MIN10IMS, ORDER),. 




ACFI 560 


02,DELT2,JL,JR=0,. 




ACFI 570 


P3,YS,VAL(11=Y(J),. 




ACFI 580 


P2, Q3=l,. 




ACFI 590 


Al =XS-APGI,. 




ACFI 600 


DISTI=ABS{A1),. 




ACFI 610 


DO I = 2 TO N,. 


/•START TABLE SELECTION 


•/ACFI 620 


JJR =J'*'JR,. 




ACFI 630 


IF JJR GE DIMS 


/•TABLE SELECTION 


•/ACFI 640 


THEN GO TO LAB2.. 




ACFI 650 


JJL =J-JL,. 




ACFI 660 


IF JJL LE 1 




ACFI 670 


THEN GO TO LAB3.. 




ACFI 680 


IF SW= •£• 




ACFI 690 


THEN A =-Al*Z2,. 


/*A=(ARG(I-l)-XVAL)^DX 


•/ACFI 700 


ELSE A =ABS(X(JJR+1) 




ACFI 710 


-XS)-ABS(X( JJL 




ACFI 720 


-l)-XS),. 




ACFI 730 


IF A LE C 




ACFI 740 


THEN GO TO LAB3,. 




ACFI 750 


LAB2.. 




ACFI 760 


JL =JL*1,, 


/•STEP TO THE LEFT 


•/ACFI 770 


K =J-JL,. 




ACFI 7B0 


GO TO CONT,. 




ACFI 790 


LAB3.. 




ACFI 800 


Jfi =Jfi*l,. 


/•STEP TO THE RIGHT 


•/ACFI 810 


K =J+JR,. 




ACFI 820 


CONT.. 




ACFI 830 


IF SW= 'E' 




ACFI 840 


THEN A =Zl+FL0ATIK-l)*Z2,. 




ACFI 850 


ELSE a =XIK).. 




ACFI 860 


Al =XS-A.. 




ACFI 870 


IF SW='M' 




ACFI 880 


THEN DO,. 




ACFI 890 


DiST =Aas(An.. 




ACFI 900 


IF DIST LT DISTl 




ACFI 910 


THEN GO TO lOENT,. 


/•ARGUMENTS NOT HONOTONIC 


♦/ACFI 920 


DIST1=DIST.. 




ACFI 930 


END,. 




ACFI 940 


ARG(I1=A,, 




ACFI 950 


VALII)=Y1K).. 




ACFI 960 


END,. 


/•END OF TABLE SELECTION 


•/ACFI 970 


Al =XS-ARG(1),. 




ACFI 980 


DO I = 2 TO N,. 


/«;;tart interpolation loop 


•/ACFI 990 


II =0.. 




ACFIIOOO 


PI =P2.. 


/•MOVE parameters P2,P3,Q2 


03 •/ACFUOIO 


Ql =02.. 




ACFTIOZO 


P2 =P3,. 




ACFI1030 


02 =Q3.. 




ACF11040 


ZS -YS.. 




ACFI1050 


0ELT1=DELT2,, 




ACFI1060 


ARGI =ARG{I ),. 




ACFI1070 


VALI =VAL(I),. 




ACFU080 


INVERT,. 


/•COMPUTE INVERTED DIFFERENCES */ACFIl090| 


AR(5!1=ARGI,. 




ACFIllOO 


VALI1=VALI,. 




ACFIUIO 


00 J = 1 TO I-l,. 




ACFI1120 


ARGJ =ARGIJ)., 




ACFI1130 


H =VALI-VAL(Ji,. 




ACFIU40 


IF ABS(H) LE ABS(VALI)*EPS1 


ACFI1150 


THEN OD,. 




ACFI1160 


IF ARGI= ARGJ 


/•ERROR RETURNS, IF TWO 


♦/ACFI117C 


THEN GO TO IDENT,. 


/•IDENTICAL ARGUMENTS EXISl 


♦/ACFI1180 


If J GE I-l 




ACFI1190 



THEN DO,. 






ACFI1200 


II 


II+l.. 


/•INTERCHANGE ROW I WITH 


♦/ACFI1210 


III = 


I*II,, 


/•ROW I + H 


♦/ACFI1220 


IF III 


GT N 




ACFI1230 


THEN GO TG RETURN,. 


ACFIU'.'i 


Vali = 


VALIIin 




ACFI12SU 


VALIIID-VALIl 




ACFI1260 


ARGI = 


ARGIIin 




ACFU270 


ARGdin^^ARGIl 




aCFI1280 


GO TO 


INVERT,, 




ACFI 1290 


END,. 






ACFI1300 


VALI =l£75. 


. 


/•VALID = VAUJ), J LT I-l 


♦ /ACFU3I0 


ENO,. 






ACFI1320 


ELSE VALI =IARGI 




/•VALID NE VAUJ) 


♦/ACFI1330 


-ARGJt/H,. 






4CFI1340 


END,. 






ACFI1350 


P3 =VALI*P2+AI^Pl,. 




/•COMPUTE INVERTED DIFFERENCES */ACFIl36C 1 


Q3 =VALI*Q2+A1^Q1.. 




/♦BY HALLIS-EULER SCHEME 


♦/ACFI1370 


VAL(I)=VALI,. 




/♦GENERATE NEW VALID, ARG(D 


•/ACFI1380 


ARG(I}=ARGI,. 






ACFI I 390 


Al =XS-ARGI,. 






ACFI1400 


IF Q3» 






ACFI1410 


THEN YS =1E75,. 




/•03 * 


♦/ACFI1420 


ELSE YS =P3/03,, 




/•03 NE 


♦/ACFI143C 


DELT2«ABS(ZS-YS),, 






ACFI 1440 


IF DELT2 LE EPS 




/•TEST ON ACCURACY 


•/ACFI1450 


THEN GO TO STOP,. 






ACFI1460 


IF 1 GE 8 




/♦SINGLE PRECISION VERSION 


/♦S*/ACFI1470 


/* IF I GE 10 




/•DOUBLE PRECISION VERSION 


/♦0+/ACFI1480 


THEN IF DELT2 6E DELTl 




ACFI1490 


THEN GO TO OSCIL,. 






ACFU50C 


END,. 




/♦END OF INTERPOLATIOM LOOP 


•/ACFI1510 


GO TO RETURN,. 






ACFI1520 


IDENT.. 




/♦AR6II) - ARG(J) FOR ! NE J 


♦/ftCFI1530 


ERR0R=*3«,, 






flCFT154C 


GO TO RETURN,. 






ACFI1550 


OSCIL.. 




/♦DELT2 STARTS OSCILLATING 


•/ACFI1560 


YS =ZS,. 

ERROR='l',. 

GO TO RETURN,. 
STOP.. 

ERROR='0',. 
RETURN., 

YVAL =YS,. 






ACFI I 570 
ACFIISBO 
ACFI 1590 






ACFI1600 
ACFI1610 
ACFI1620 
ACFI1630 


END,. 




/•END OF PROCEDURE ACFI 


•/ACFI1640 



Purpose: 

ACFM interpolates the function value YVAL for a 
given argument value XVAL using a given table (X, 
Y) of arguments and function values. 

Usage: 

CALL ACFM (X, Y, DIM, ORDER, EPS.XVAL, YVAL); 

X - BINARY FLOAT [(53)] 

Given vector of monotonic arguments. 
Y - BINARY FLOAT [(53)] 

Given vector table-fuQction values. 
DIM - BINARY FIXED 

Given dimension of vector X and Y. 
ORDER - BINARY FIXED 

Given number of points to be selected 

out of the given table (X, Y). 
EPS - BINARY FLOAT [(53)] 

Given constant used as upper bound 

for the absolute error. 
XVAL - BINARY FLOAT [(53) ] 

Given argument to be interpolated. 
YVAL - BINARY FLOAT [(53)] 

Resultant interpolated function value. 

Purpose: 

ACFE interpolates the function value YVAL for a 
given argument value XVAL using XST, the starting 
value of the arguments, DX, the increment of the 
argument values, and vector Y of function values. 
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Usage: 



with X. = ARG(i), y. = VAL(i) 



CALL ACFE (XST.DX.Y, DIM, ORDER, EPS, XVAL, 
YVAL); 

XST - BINARY FLOAT [(53)] 

Given the starting value of the argu- 
ments. 
DX - BINARY FLOAT [(53) ] 

Given increment of the argument values. 
Y - BINARY FLOAT [(53)] 

Given vector of table-function values. 
DIM - BINARY FIXED 

Given dimension of vector X and Y. 
ORDER - BINARY FIXED 

Given number of points to be selected 

out of the given table (X, Y). 
EPS - BINARY FLOAT [(53)] 

Given constant used as upper bound for 

the absolute error. 
XVAL - BINARY FLOAT [(53) ] 

Given argument to be interpolated. 
YVAL - BINARY FLOAT [(53) ] 

Resultant interpolated fimction value. 
Remarks: 

See AHIM/AHIE, ALIM, ALIE 

Method: 

Interpolation is done by a continued fraction and 
inverted differences scheme. 

For reference see: 

F. B. Hildebrand, Introduction to Numerical Analy- 
sis . McGraw-Hill, New York-Toronto-London, 
1956, pp. 395-406. 

Mathematical Background: 

Before starting continued fraction interpolation, a 
table (ARG, VAL) must be selected out of the given 
monotonic or equidistant table. This selection is 
done before the continued fraction interpolation in 
the same way as in ALIM/ ALIE. 

It is assumed that | x(i) - XVAL | > | x(j) - 
XVAL I for all i> j ; otherwise, ERR0R='3' is 
returned. 

Using the following formulas: 

X - X, 

n 1 



l.n y^-y^ 



X -X 

n m 



the triangular scheme of inverted differences shown 
in Figure 9 can be generated by row for the table 
(ARG, VAL). All resultant values of row i can be 
stored in VAL(i). Thus, it is possible to generate 
the downward diagonal of the inverted differences 
scheme in vector VAL: 



ARG(i)^^ARG(j)_ 
VAL(i) - ^^j^^.^ _ ^^^^.^ (J - 1,2,. 

for i = 2,3, ... , MIN(DIM, ORDER). 



,1-1) 



If for j = i-1, VAL(i) is equal to the infinity ele- 
ment, table point ARG(i), VAL(i) is interchanged 
with a table point ahead. 

Now, after computation of each new component 
VAL(i), continued fraction interpolation generates 
the following parameters using Wallis-Euler 
formula: 

P3 = VAL(i) • P2 + (XVAL-ARG(i-l)) • PI 
Q3 = VAL(i) • Q2 + (XVAL-ARG(i-l)) • Ql 
and YVAL = P3/Q3, 



starting with PI = 1, P2 
= 1. After each step, PI 
= Q2, Q2 = Q3 are set. 



VAL(l), Ql = 0, Q2 
P2, P2 = P3, Ql 



ARG(l) = Xj 


VAL(l) = y^ 








ARG(2) = Xg 
ARG(3) = Xg 


VAL(2) = y^ 
VAL(3) = yg 


5'l,2 






^1,3 ^1,2,3 


ARG(n) = X 


VAL(n) = y^ 


''l.n ^l,2,n" ■ ■ 


■ • ''1,2,3,. 


. ,n 



^'^ "^'^ ^1,2 m-l,n -^1,2 m 



Figure 9. Triangular scheme for fraction interpolation 

Programming Considerations: 

The procedure stops under the following conditions: 

1. If the absolute value of the difference between 
two successive values of YVAL is less than a given 
tolerance EPS, ERROR='0' is returned. 

2, K the absolute value of this difference starts 
oscillating, ERROR='l' is returned. (Test starts 
at step i = 8 for single precision, i = 10 for double 
precision. ) 
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3. If the number of interpolation steps has be- 
come MIN(DIM, ORDER), ERR0R='2' is returned. 

4, If the procedure discovers that two table 



points have identical argument values or that the 
arguments are not monotonic, ERR0R='3' is 
returned. 



PROCEDURE 4CFM PERFORMS CONTINUED FRACTICN I M ERPC1.4T ION IN 4 GIVEN >10N3TnNIC TSBLE 
ENTRY 4CEE INTERPCLATES IN AN EQUIDISTANT TABLE 



**»*A1*»***»*** 

• « 

'PRUlEOURE acfm • 

* * 



*«9** til*** ******* 

* HARK ENTRY • 
» AtFN, SEARCH * 

* FIRST TABLE * 
» ENTRY (LINEAR • 

* SCAN) * 



***»»C1*** **«««** 



•SAKE INDEX J OF* 
* TABLE ENTRY » 



**t* *** *******^*# 



*****D1«** ******* 

* * 
*FtICH AND STORE* 

* CLOSEST * 

* ARGUMENT * 

* * 
***************** 



***** El ********** 

* PRESET * 

* ERROR=' 2' SET * 

* UP INTERNAL * 
*TOLeRANCE EPSl * 

* * 
***************** 



*****f I********** 
*COMPUIE MAXIMAL* 
*NUHBER OF TABLE* 

* POINTS TO BE * 

* USED * 

* * 
***************** 



*****G1*** ******* 

* INITIAL IZE JL * 

* AND JR (LEFT « 
»AND RIGHT INDEX* 
*SIEPS IN TABLE)* 

* * 
***************** 



***** HI*** ******* 

* INSERT FIRST * 

*FUNCIION VALUE » 

* IN TRIANGULAR * 

* SCHEME * 

* * 
***************** 



*****J I********** 

* * 

* COMPUTE * 

* DIFFERENCE OF • 

* ARGUMENTS Al * 

* * 
***************** 



****A?**»****** 

* • 

* ENTRY ACFE • 

* * 
****«4«**4*«*«« 



*****B2*********» 

* MARK ENTRY » 
*4CFE, CALCULATE* 

* FIRST TABLE * 

* ENTRY * 

* » 
***************** 



*****C2 ********** 



♦SAVE INDEX J OF* 
*_ TABLE ENTRY * 



.«*«««****««**«««* 



*****D2********** 
« * 

* CALCULATE AND * 

* STORE CLOSEST * 

* ARGUHENT * 
•_ » 
***************** 



***** A3* ********* 
» * 

• PERFORM • 
.X* INTERPOLATION * 

• LOOP * 

• « 



*****B3** ******** 

* INITIALIZE * 
*CALCULATlnN OF * 

X* INVERTED «. 

*OIFFERENCE ROH * 

* * 
***************** 



E2 *. 


E3 ». 


. * HAS *. 


. * HAS * . 


NO .*TABLF SIILI*. 


YES .*TABLE STILL*. 


..*. VALUES TO .*X.. 


*. VALUES TO .* 


*. LEFT .* 


*. RIGHT .* 


*. . * 


*. .* 


*. . ♦ 


*. .* 


• YES 


* NO 



F2 *. 

. * *. 

. * SHOULD *. 

. STEP BE TO . 

*. THF RIGHT.* 

♦. . * 

*. . * 

* YES 



»****G 2 ********** 

* UPDATE INDEX * 
*STEP JR AND SET* 

..X* UP INDEX OF *. 

* TABLE VALUE * 

* * 
***************** 



*****F3**« ******* 

* UPOATF INDEX * 
*STEP JL AND SET* 

.X* UP INDEX OF • 

* TABLE VALUE * 

* * 
***************** 



*****G3********** 

* FETCH * 

* RESPECT IV ELY * 
.X*CALCULATE NEXT * 

* ARGUMENT USED * 

* * 
***************** 



*****J2 ********** 

* * 
*STORE ARGUMENT * 

* AND FUNCTION *X. 

* VALUE * 

* * 
***************** 



H3 *. 
.* *. 

NO .* MAS 

...*. ENIY VIA 
*. ACFH 
*. .* 

*. .* 
* YES 



J3 *. 

.*IS NEW *. 

NO .* POINT *. YES 

...*. CLOSER TO .*.... 

*. GIVEN .* 

*.XVAL .* 



****«fl A********** 

* PREPARE * 
*CALCULATION OF * 

* NEXT INVERTED *X . 

* DIFFERENCE « 

* » 



*****(^ 4*«*«4***4« 

* CALCULATE * 

* CURRENT * 
INVERTED * 

« DIFFERENCE IF * 

* POSSIBLF » 
»*********#****«* 



.X* 



.tnFNOMINATOR*. NO 
. INTOLERABLY . *. ., 
*. SMALL .* 



.*. 

04 *. 
.* ARE *. 
NO .*CORRESPOND.*. 
...*. ARGUMENTS . 
*.niFFFRFNT.* 



X 

.*. 



.*0!FFERENCE *. NO 
LAST IN .*... 
*. »,0H .* 



F4 *. 

.*INTFR- *. 

.*CHANGE WITH*. YES 

►.ALL REMAINING.*. 

*. VALUES .* 

•.TR lED.* 



* NO 



♦****G4********** 

* INTFRCHANGE * 
*LAST POINT USED* 
*WITH REMAINING * 

* ONE * 

* * 
***************** 

I **** 

* * 
..X* B3 * 

* * 
**** 

*****H4********** 

* * 

* SET ERR0R="3" * 
.X* ( TABLE N3T * 

* MONOTONIC) * 

* * 
***************** 



*****J4*«******«« 

* * 

* RETURN * 

* INTERPOLATED * 

* VAL UE * 

* ♦ 
***************** 



B5 «. 

. * FULL *. 
.* ROW 

.X*. CALCULATED 



*****C 5 ********** 
*MOniFY VALUE CF * 

* INVERTED * 
.X* DIFFERENCE TO * 

* I NF I NI TY * 

* * 
***************** 



*****05*******»** 

* * 

* EVALUATE * 

* CONTINUED *X.. 

* FRACTION * 

* * 
*********«*»«**♦* 



. *. 
E5 *. 
.* ARE *. 
.*SUCCESSIVE *. NO 
*. VALUES .*... 

*. SUFFIC. .* 
*.CLOSE. * 
*. . * 
* YES 



*****F 5 ********** 

* * 

* SET FRROR«'0' * 
. * (SUCCESSFUL * 

*I NTERPOLATI CN) * 

* * 
***************** 



G5 *. 
. * DOES *. 
. *OSCILLATI CN*. NO 
. INDICATE .*... 
*. ROUND OFF.* 
*. . * 

*. . * 
* YFS 



*****H5*** ******* 



* SET ERROR='l" 
. * (ROUND OFF! 



***************** 



J5 *. 

. * ARE *. 

NO .* STILL *. 

. ..*. VALUES TO BE .*X. 

*. USED . * 



« « 

* iNiTIALIZE • 

♦TAtiLE SELECTION*.. 

* LOOP * 

* ♦ 


K2 ♦. 

. «. ARE ♦. 
NO .* ENOUGH *. 
..X,..*, POINTS 

♦.SELECTED .♦ 
♦ . . * 
X *. . * 
♦ *** * 
* * 


YES 
* 


«**»«K3********«* 

♦ * 

♦ INITIALIZE • 
..X* INTERPOLATION*.,., 

• LOOP » 

* * . 

* * 


X 
*#**K4********* 

* END OF * 

* PROCEDURE * 

* ACFM/ACFE • 


* PREPARE ♦ 

♦CALCULATION OF • 

...» NEXT • 

. * INTFRPOLATION * 

. * VALUE ♦ 




* E3 * 

* * 




* A3 * 

* « 




♦ A3 * 




*»♦♦ 




**** 




«*** 


Mathematics- 


-Interpolation 











Approximation of Tabulated Functions 



• Subroutine FFT 



FFT.. 






FFT 


10 


/****** 




**/FfT 


20 


/* 






*/FFT 


30 


/■! 


FAST FOURIER TRANSFORM FOR 


ANY ONE-DIHENSIONAL ARRAY 


• /FFT 


40 


/• 






*/FFT 


50 


/+***** 


««4<«««*««*«4.#«** «****«««»*#«** 


*m***************************M***/ffJ 


60 


PPDCeOUBE(A,M,OPT»,. 






70 


DECLARE 






80 




EPROP EXTERNAL CHAftACTER( I ) j 


/♦EXTERNAL ERROR INDICATOR 


*/FFT 


90 




(OPT, COPT) CHARACTERiUt 






100 




(OA,OB,OC,OH,DS,RI1 






110 




BINARY FL0AT(53), 






120 




(A(*),S(2**(M-2»+II,AAR, 






130 




AAI,ABR,A6I,AM,CCI,SI) 




FFT 


140 




BINARY FLOAT, 


/•SINGLE PRECISION VERSION /•SVFFT 


150 


/* 


BINARY FLaAT(53l , 


/*00U8Le PRECISION VERSION /*D*/FFT 


160 




U.IO.IND.IR.IST, 




FFT 


170 




J,K,L,M,N,NH,NQ) 




FFT 


180 




BINARY FIXED,. 




FFT 


190 


IF M 


LT 2 


/*TEST SPECIFIED DIMENSION M 


• /FFT 


200 


THEN 


00 , . 




FFT 


210 




ERROR='P't. 


/*P MEANS WRONG PARAMETER 


*/FFT 


220 




GO TO RETURN,. 




FFT 


230 




END,. 




FFT 


240 


£RRQR='C'.. 


/•PRESET ERROR INDICATOR 


*/FFT 


250 


COPT 


=OPT,. 




FFT 


260 


N 


=2**M,. 


/•INITIALIZE PARAMETERS 


*/FFT 


270 


NH 


=N/10B,. 




FFT 


287r 


NQ 


=N/100B+2,. 




FFT 


29C 


L 


=NQ+U. 




FFT 


30C 


Ri 


= 3.l'il592653589793E+00/NH,. 


/•RI MEANS 2*PI/N 


*/FFT 


310 


DA,S( 1)=C,. 


/•SET SINE FOR AND Pl/2 


«/FFT 


320 


0B,S(NQ-U = 1,, 




FFT 


330 


DS,S(2) = SIN(RI ),. 




FFT 


340 


DC 


=COS(RI),, 




**/FFT 


350 




DO ! =3 TO N/10006+1,. 


/•CALCULATE SINE TERMS 


• /FFT 


36C 




RI =OC*OB,. 


/•BETWEEN AND PI/2 


*/FFT 


370 




S(L-II,OH=RI-DA,, 


/>;* *:*«:*« t<**4r«*«««««««««*«***«4r 


♦*/FFT 


380 




DA =DR,. 




FFT 


390 




D6 =RI»-DH,. 


/•CALCULATION IS DONE USING 


•/FFT 


400 




5( I) =D6*0S,. 


/•DOUBLE PRECISION ARITHMETIC 


♦/FFT 


410 




END,. 




FFT 


4T0 


IF copr= 'z' 


/*'2' MEANS CALCULATION OF 


*/FFT 


430 


THEN 


GO TO REAL,. 


/•REAL FOURIER SERIES 


•/FFT 


440 


IF COPT= '3' 


/*'3' MEANS CALCULATION OF 


*/FFT 


450 


THEN 


GO TO INV,. 


/•COMPLEX FOURIER SERIES 


*/FFT 


460 


AW 


=I/NH,. 




FFT 


470 




00 I =1 TO N,. 


/•PREPARE VECTOR A FOR FINITE 


*/FFT 


480 




A( I ) =A( 1 )«AM. . 


/•FOURIER TRANSFORM 


•/FFT 


490 




END,. 


/**♦**«.,»******«♦****#♦#»**»» 


••/FFT 


500 


INV.. 




/•REORDER INITIAL TERMS AID 


*/FFT 


510 


J 


= 1, . 


/•BY BIT REVERSAL TECHNIQUE 


• /FFT 


520 




DP I =1 TO N BY 2,. 


/ f*i)Ht**:**t*******a*f:-******»**** 


••/FFT 


530 




IF J GT I 


/•IS BIT REVERSAL GREATER THAN 


• /FFT 


540 




THEN DO,. 


/•INIT. BINARY REPRESENTATION 


«/FFT 


550 




AAR =A(J),. 




FFT 


560 




AAI =AIJ+I),. 


/•INTERCHANGE All) WITH AtJ) 


*/FFT 


570 




AIJ) =A{I),. 


/•AND A(I+1) WITH A(J+11 


♦ /FFT 


5 80 




A( J+1)=A( I + l),. 




FFT 


590 




Adl =AAR,. 




FFT 


600 




A(I+I(=AAI,. 




FFT 


610 




END,. 




FFT 


620 




K =Nh, . 




FFT 


630 




DO WHILE (J GT K),. 


/•UPDATE J AND K 


«/FFT 


640 




J =J-K,. 




FFT 


650 




K =K/1CB,. 




FFT 


660 




END, . 




FFT 


670 




J =J+K,. 


/•COMPUTE NEW BIT REVERSAL 


♦/FFT 


680 




END, . 




FFJ 


690 


rR,i 






FFT 


700 


ID 


=NH, . 


/«***#♦**»»♦»***»»**»#**##*#»» 


••/FFT 


710 


CPLX,. 




/♦COMPLEX FOURIER TRANSFORM 


• /FFT 


720 






/•WITH N/-2 ELEMENTS 


«/FFT 


730 


1ST 


=1*1,. 


/S*Hi«««««««t ««««««««« 6 4* «****« 


•«/FFT 


740 


IND 


= 1, . 




FFT 


750 




DO J =1 TO I BY 2,. 




FFT 


760 




SI =-S( INOl .. 


/•STORE SINE VALUES IN SI 


*/FFT 


770 




IF COPT= •3' 


/"CHANGE SIGN IN CASE OF 


*/FFT 


780 




THEN SI =-SI,. 


/•FOURIER SERIES 


• /FFT 


790 




CO =S(NO-INDl ,. 


/•STORE COSINE VALUES IN CO 


• /FFT 


800 




11^ J GE IR 




FFT 


810 




THtN DO,. 


/•MODIFY INDEX INO OF THE 


*/FFT 


82C 




!ND =!ND-ID,. 


/•SINE VECTOR S 


*/?fT 


830 




CO =-C0,. 


/•C0S(PI/2+B) = -SIN(B) 


•/FFT 


840 




END, . 




FFT 


850 




ELSE INO =IND+ID,. 




FFT 


860 






/•EXECUTE TRANSFORMATION-LOOP 


• /FFT 


870 




00 K =J Tn N BY 1ST,. 




FFT 


880 




L =K+I,. 




FFT 


890 




AAK =C0*A(L)-SI*A(L+1), 




FFT 


900 




AAI -CP*A(L+U + SI*A(L1, 




FFT 


910 




A(L) =A)K)-aAR,. 


/•MODIFY AND RESTORE ELEMENTS 


•/FFT 


920 




AU+1)=A(K+U-AAI,. 




FFT 


930 




A(K) =A(K)+AAR,. 




FFT 


940 




A(K+l)=A(K*l)+AAI, . 




FFT 


950 




END,. 




FFT 


960 




EW, . 




FFT 


970 


IB 


= 1 + 1, . 


/•UPTATE PARAMETERS 


*/FFT 


980 


I 


=IST,. 




FFT 


99 C 


!C 


=ID/1CE,. 




FFT 


1000 


IF I 


LE NH 




FFT 


1010 


THEN 


GO TS CPLX,. 


/•END OF OUTER LOOP 


♦ /FFT 


1020 


IF COPT= ■ I' 


/••I' AND 'S* MEAN COMPLEX 


♦ /FFT 


1030 


THEN 


GO TO RETURN,. 


/•FOURIER CALCULATIONS 


♦ /FFT 


1040 


JF COPT= '3' 




FFT 


1 050 


THEN 


GO TO RETURN,. 


/>Kftil'«*i«»«i>4t*«****4ci|c«**«:«>|>«««4>* 


•♦/FFT 


IC60 


REAL.. 




/•REAL VALUES FROM (FOR) 


• /FFT 


107C 


I 


= 1,. 


/•COMPLEX FOURIER TRANSFORM 


♦ /FFT 


1080 




DO K =3 TO NH-1 BY 2,. 


/«*«*:»W«*>|>*««««ft4:«;iK*iK:4i:(t4i4:ii*4c««; 


♦*/FFT 


1090 




J =N-K+2,. 




FFT 


1100 




AAR =A(K» *A(J), 




FFT 


IllO 




AAI =A(K+11-A(J+1),. 




FFT 


1120 




A6R =A(K + n + *( J+1) .. 




FFT 


1130 




A6I =A{J) -A(K),. 




FFT 


1140 




I =1+1,. 




FFT 


1150 




S! =S(I),. 


/•STORE SINE AND COSINE 


«/FFT 


1160 




CO =s(No-n,. 




FFT 


117C 




AW = A5R*C0+ABI*SI,. 




FFT 


1160 




flSI =-ASt*C0+A8R*SI,. 




FFT 


1190 




AlKJ =1 AAR+AW )*1E-IB,. 




FFT 


1200 



A(K*1)=(-AAI+ABI)*1E 


-IB,. 




FFT 


121C 


A(J) =( AAR-AW )^1E- 


B,. 




FFT 


1220 


A(J + 1) = ( AAI+APU^IE 


-IB,. 




FFT 


1230 


END,. 






FFT 


1240 


AH =AIU,. 






FFT 


1250 


IF COPT= '2' 




/•PREPARE A(1),AI2) FOR 


• /FFT 


1260 


THEN DO, . 




/•CALCULATION OF REAL FOURIER 


*^/FFT 


1270 


All) =(AW+A(N+1) ),. 




/•SERIES 


• /FFT 


1280 


A12) =(AW-fllN+ll ) ,. 






FFT 


1290 


COPT = >3',. 




/•CHANGE INTERNAL OPTION TERM 


*/FFT 


1300 


GO TO I NV . . 






FFT 


1310 


END,. 






FFT 


132C 


AI 1) =1AW+A1 2H*lE-ie,. 




/•CALCULATE VALUES 


*/FFT 


1330 


A(N+1)=1AW-A(2))^LE-1B,. 




/*A{l),A(2),A(N+l),A(N«-2) 


«/FFT 


1340 


AI2) =0,. 






FFT 


1350 


A(N+2)=C,. 






FFT 


136C 


RETURN.. 






FFT 


1370 


END,. 




/•END OF PROCEDURE FFT 


*/FFT 


13B0 



Purpose: 

FFT performs finite one-dimensional Fourier 
analysis and synthesis for a set of N=2^ real data, 
or for a sequence of -S- = 2^"^ complex data. 

Depending on the cnaracter of the input parameter 
OPT, the following transformations can be done: 



real analysis 
complex analysis 
real synthesis 
complex synthesis 



OPT 


= '0' 


OPT 


= '1' 


OPT 


= '2' 


OPT 


= '3' 



Usage: 

CALL FFT (A,M,OPT); 



A(2^or2^ + 2) 



N=2M 



N+2=2^+2l 



Fourier 
calculations. 



BINARY FLOAT [(53)] 

Given one-dimensional array 
with length 

1 (complex 

fori 
(real 

Resultant transform values are 
returned in the array A, replacing 
the input data. 

The contents of the input and out- 
put array A depend on the option 
parameter OPT: 
In cases OPT = '1' and OPT = 
'3' the complex data are located by 
pairs in N immediately adjacent 
storage locations. In the other 
cases the N function values are 
stored in N successive storage 
locations, while the Fourier co- 
efficients a(n), b(n) need N+2 
locations and they are stored as 
follows: 
a„ 



b,=0, 



"1' "r ^2' 2' 



N 



N 
' 2 

= 



2 



N 
2 
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M- 



BINARY FIXED 

Given integer that determines the 

size of vector A, 

The size of A is 



jM 



,M 



+ 2 



j complex 1 



for 



real 



Fourier 
calculations. 



OPT 



Remarks: 



CHARACTER(l) 

Given option parameter for selec- 
tion of operation (see "Purpose"). 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error condition 
that may be detected: 

EIlROR='P' means error in specified parameter — 
for example, M < 2, Any value of OPT different 
from '1', '2', '3' is treated as if it were '0'. The 
integer N in the given formulas (see "Purpose") 
miist be a power of two: 



N = 2 



M 



J. W. Cooley and J. W. Tukey, "An Algorithm for 
the Machine Calculation of Complex Fourier Series", 
Mathematics of Computations, vol. 19, 1965, pp. 
297-301. 

Mathematical Background: 

Complex Fourier calcxilations 

Let X(k), k = 0, 1, 2, . . . , N-1, be a sequence of 
N = 2^ complex numbers. The finite Fourier 
transform of X(k) is defined as 

A(n) = T7 L X(k) . W "°*^ 
k=0 



n =0,1, ...,N-1 



(1) 



where 



Wn = exp (-^) and i =^ 



Similarly, X(k) can be expressed as the finite 
Fourier series of A(n) 



FFT is restricted to one-dimensional Fourier 
transformations. 

Another procedure, called FFTM, is available 
in SSP-PL/I which operates on multidimensional 
arrays. 

For real and complex applications of FFT the 
following is true: A forward transform (Fourier 
analysis) followed by an inverse transform (Fourier 
synthesis) returns the original data (except for 
roundoff errors). 

Method: 

Calculations depending on the option parameter OPT 
are done using the Cooley- Tukey Fast Fourier 
Transform. 

For reference see: 



N-1 



X(k) = Z A(n) • w 



n-k 



n=0 



N 



(2) 



Since N = 2^ we express X(k) as a function of the 
M arguments kj^_2^, kjyj_„ * ' * ' kj^, kg of the binary 
representation of k: 



oM-1 . , „M-2 

k = k , , • 2 + k,, „ • 2 

M-1 M-2 



+ ... k, . 2 +k„; k = or 1. 
1 V 



(3) 



Analogously, if 

„M-1 „M-2 



J. W. Cooley, P. A. W. Lewis, P. D. Welch, "The 
Fast Fourier Transform Algorithm and its Applica- 
tions", IBM Research, RC 1743, February 9, 1967, 
pp. 15-33. 

N. M. Brenner, "Three Fortran Programs that 
Perform the Cooley- Tukey Fourier Transform", 
Lincoln Laboratory, Massachusetts Institute of 
Technology, Lexington, Technical Note ESD-TR-67- 
462, 1967. 



+n„ ; n = or 1, 
V ' 



then equation ( 2) can be written; 



^^M-1, '^M-2 '^I'V 



1 1 



\^ \^ ""u-i^ 



E „ ^('^M-l' °M-2' 



(4) 
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■VV • Wn'^<'^m-i'2 



M-1 



+ . . . + Dj^ • 2 + n^) (5) 



2 N 

Using W:, = W„ = 1, we have 

N N 

oM-1 , „M-1 

^N N 



Therefore the innermost sxun in equation (5) yields 
an array: 



\<V^M-2'""VV = 






w. 



Vm-1 • 2 

N 



M-1 



Then, summing over n]yi_2 to get an array Ag from 
Ai, and so on, leads to the general formula (L = 1, 
2,3 M): 



\^0"'" ^L-1' ^M-L-1 '^l' V 



M-L 



..., Hj^.Qq) 



•W, 



<kL-l-2''"'-^--^V-"M-L2''"'^ 



Now we must reverse the order of the bits in the 
binary representation of k. FFT does the reorder- 
ing on the initial array so that the result is in the 
correct order. 

Real Fourier calculations 

Given 2N real data Y(j), j = 0, 1, 2, . . . , 2N-1. The 
coefficients of the trigonometric series 



Y(J) =f)+z\a(n).cosI|^ 
n=l 

+ b(n) -sin-f-) + (-1)^^ 



can be derived from the N-point complex Fourier 
transform 



J N-1 _ 

A(n) =17 E X(k)'W^'^ n = 0,l,2,...,N-l 
K=0 



where X(k) = Y(2k) + iY(2k+l) ; k = 0, 1, 2 N-1. 

Let (the bar is conjugation): 



2C(0) 


= Re A(0) + Im A(0) 


2C(N) 


= Re A(0) - Im A(0) 


N 


T ,N 


2C(-) 


'*<2' „ 



N 
Calculate for m = 1, 2, . . . ,— - 1: 



Ai(m) =-(A(m) + A(N-m)) 
Ag (N-m) = y.(A(m) - A(N-m) ) 
2C(m) = Ai (m) + A^ (N-m) • W, 



-m 
2N 



-m 



N 



2C(N-m) = Aj(m) - A^ (N-m) • W^^^ 



The final array will be the desired X. The 
storage indexing convention used here is to let the M 
arguments of Al (kg, . . . .Uq) be the binary representa- 
tion of the index of the storage location for Al 
(kQ, . . . .ng). In this way, each step of the algorithm 
involves fetching from two storage locations and 
returning results in the same two locations, thereby 
saving storage. However, the elements of the final 
array are in wrong order: 



Now, identify the a(n), b(n) coefficients by means 
of the relations 



a(0) = 2C(0) 

a(N) = 2C(N) 

a(n) = 2ReC(n) 

b(n) = -2 ImC( 



n)} " = 1'2,..., 



N-1. 



Note ; To compute the 2N real Y(j) (Fourier 
synthesis) when the coefficients a(n) and b(n) are 
given, the process described above is applied in 
reverse order. 
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Programming Considerations: 

FFT accepts input data stored according to 
option parameter OPT: 



OPT = 
OPT 



= '3' f 



any set of 2" = 2 "•*■ complex values 
whose real and imaginary parts are 
( located by pairs in N adjacent storage 
) locations. 
OPT = '2' the coefficients 



2 ' ^' ^1 ' ^1 ' • • • J 



2 2 2 2 



in N + 2 successive storage locations. 

OPT = '0' N real elements in successive storage 
locations. 

During calculation, input vector A is replaced by 
results depending on the character of parameter 
OPT, These results are stored in an analogous 
manner. For example, with OPT = '0', FFT 
calculates the N+2 Fourier coefficients a(n), b(n) 
and stores them into array A (with length N+2), 
overwriting the first N given real values. 
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HkOtcUjuE fFT PtRFURMS FINITE, flNF-nl fE NSI ONAL FOURIER CALCULATIONS FOR A SET OF N>2»»1 ?FAL OA TA «(L) 



L = l ,2,... ,N 



***»A1********» 

# * 
» PKUlEOURE FFT * 

* * 
*************** 



dl *. 

.* IS f1 *. 

.« GREATER *. 

# -THAN OR EQUAL . 

*. TO 2 .* 



**** 

* * 
» A5 * 

* * 
*«** 



*»***C 1********** 

* * 
*JET bRROR-'P', * 

* P MEANS VtRONG * 

* PARAMETER » 

* * 
*♦•*#*«*♦*******• 



*****B2********** 

* « 

• PRESET * 
X* ERROR='0" » 



***************** 



*****C 2 ********** 
*REStORF OPTION » 

* PARAMETER DPT * 

* INTO LOCAL • 

* STORAGE COPT * 

* • 
***************** 



**«» #02 **»*«*♦*** 

* * 
» CALCULATE * 
•NUMBER OF DATA * 
» N=2**M * 

* • 
****«**«**♦♦***** 



*****E 2 **«***««** 
*CALCULATE SINE » 
♦AND COS! NE OF 0* 

• UP TO PI/2 KITH* 

• INCREMENT VALUE* 

• OF 2*PI/N • 
****«***•«**«•**« 



F2 •. 

. * I S *. 

.* C0PT»'2' , 

*. I.E. REAL 

*. FOURIER . 

*.SERIE.* 



* NO 



G2 *. 

. • IS •. 
YES .• C0PT=-'3'. • 
...*.I.E. COMPLEX 
». FOURIER . • 
• . SERIE.* 
*, . * 
• NO 



****«H2 *•*•****** 

* DI VIDE GIVEN * 

* SET OF N REAL » 

* DATA AIL) BY • 

* N/2 • 

* « 
***************** 



REAL 

*****F3 •»•«•*••*« 
*CALCULATE REAL * 
•TRANSFORMS FROM* 
...X» COMPLEX ONES *X. 

• FOR A(3t UP TO * 

• AIN) • 
***************** 



.•- 

G3 *. 

.• IS *. 

.* C0PT = '2> , 

*. I.E. REAL 

•- FOURIER . 

*. SERIE.* 



INV X 

*****J2 **♦•*••*•* 
•REORDER I NITIAL^ 

• TERMS All) BY * 

• BI T REVERSAL 

• TECHNIQUE • 

• * 
••**•»*••**•*••** 



*X. 



* YES 



«*«**H3********** 

• PREPARE All) • 

• AND 412) FOR • 

• CALCULAT ION OF • 

• REAL FOURIER * 

• SERIES • 
***************** 



*****J3»****ft***» 

* * 

• CHANGE LOCAL • 
. * OPTION VALUE • 

• C0I»T = "3" • 

* * 
***************** 



***^*J 4********** 

* • 
*CALCULATE TERMS* 

• AI1),AI2). * 

• A(Nm,AIMt2) • 

* • 
***************** 



****«K2 «**«•••••• 

* INITIALIZE I "2 * 

* FOR COMPLEX • 

* FOURIER •. 
•TRANSFORM WITH » 

* N/2 ELEMENTS • 
***************** 



.X* A5 • 



* DOUBLE I AS • 
X* INCREMENT *X 

* IST»IH * 

* * 

***************** 



•♦***BS****»***** 
*INITIALIZE J=l * 
*A5 LOOP COUNTER* 
*FOR EVALUATION * 

• OF ANGLES * 

* * 
***************** 



*****C 5 ********** 

* RESTORE SI NE * 
*ANO COSINE WITH* 

. X* ARGUMENT CF * 

* PII1-J)/I • 

* • 
***************** 



**«*»05 •****♦**»* 

* • 
*CHANGF SIGN OF * 
*SINE IN CASE OF* 
*FOURIER SERIFS * 

* * 
***************** 



**^«*E5* *******•• 

* TRANSFORM AND * 
» RESTORE DATA * 
•A (LI DUE TO THE* 

* PRE-EVALUATED • 
•SPECIFIC ANGLE • 
*•••*********•*** 



♦****FS ******•*•• 

* * 

* INCREASE LCOP * 
•COUNTER J BY 2,* 

• J = J*2 • 

• * 
«•*******••**•*** 



G5 *. 
. • IS •. 

YES . • COUNTER J • 
. .. «. LESS THAN OR 
•.EQUAL TO .* 
*. I . * 

*. . * 
• NO 



*****H 5 ********** 



***************** 



J5 *. 

.* IS ». 
. • COUNTER I *. YES 
.LESS THEN CR . *. . . 
*.FQUAL TO .* 
*. N/2 . * 
*. . • 
• NO 



«*•* 

* 
K4 *.. 

* 
**** 


X 
****K4*«******* 

• END OF • 
..X^ PROCEDURE FFT • 

* * 
*************** 

X 


K5 *. 
. MS COPT^. 
NO .•"•!• OR M'*. 

•.I.E. COMPLEX .• 

•.TRANSFORM.* 
•. . • 
•. . • 
• YES 
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• Subroutine FFTM 



PRGCEDUr^ Ftfi,, ■-!,■:; J (>.i,.-ip} j , . 
DECLARE 

ecDno E-x^t^^j:!'. C'URACTEr r I J , 

OPT ".HASACTFRdl , 

( Al*l ,PI,R! .q.TK.TR, r2R,T?! , 

TiR,T3i,Ti,C,T4I ,U!I-,UU ,'J/;- , 

eiNAcy FLOAT, 

■^ BINARY FLG.U( 5M , 

I r . INO.J, JM,K ,i<? ,<3.K4,KDIF , 
KINr;,XM,KMlN,'.,LJ,LMfiX,,^( * W 

f^^l , »^ *^ A X , .^f ( N D ! M ) . ,V A , i^ '. ■"( .. N p , 

N8H,Mf)i M.-MNTilD 

BIMAfiY HXEC, . 
tRRDR-'P ' , . 
[F NJIM t."^ 1 
THEN no TO RETURN, . 
NT =--2,. 

00 1 - j, Tt, WOIM, . 

N( 1 ) ,K = i03**«H ! ) , . 

IF K LT I 

THEN GO TC RFT'J^N,. 

NI -NT*K,. 

END, . 



«U(_ F ! -OjMt-NSIONA!. 



■'•■Ml. ERROR 



DO 


INO =NOIM 


Tfl 


1 BY 


NIN 


= N( liMD) 






NH 


=Mrt*NIM 






IF 


f^ I ,N= 1 






IHi 


N GO TC! mn 1 




•^mn 


^'^anr-i 








DO 1 =- 1 


rn 


m iiY 




(E J i.E 


1 






THE ; -.n 


rn 


•iGOt , 




KM -t 


NA 


^.. 



LE "PfCTSION VERSION /*S*/FFi^i 



/"^TEST "JIJMBFR OF OIXENSIONS 



/'COMPUTE A'^JO TEST DI^fENSiON 
/*CAl.CULAr;-" fOTftL fJUM^E" OF 



/*RrH MEANS SQRT(2l/3 
/«!mo FOR =aCH DIMENSION 



/*PI r REVE'^SAL reCHMQUi 



**/rPT'^ 


?n 


«/EETM 


^r 


S/EE ri 


'lO 


ft/EFr"^ 


■sn 


<-*/FFTM 


6n 


FE"^M 


7r 


FFTM 


80 


i^/EFTM 


■30 


FFIM 


inr 


FfT" 


] K. 


CFTf^ 


l?C 


FF TM 


130 


FFT" 


ur 


S*/FEI^i 


I'iO 


O^/Fi-fS 


U.f 


EEfM 


]Tft 


f F-T'^ 


Ifif 


f-'^fH 


19C 


FFT-^ 


200 


F=^TM 


210 


!^/F= r*i 


P?0 


*/F-TM 


?^n 


FFTM 


240 


■^FT'I 


:>'ifi 


E^ 'M 


;!6e 


'-/FFTM 


27C 


FET-^ 


?sc 


*/FETM 


?qn 


*/rc rm 


mr. 


c- :■/, 


310 


'■■/F;- '"! 


3/C 


FFTM 


3^r 


*/FFT" 


340 


**/FE :}^ 


■I'i'^ 


*/FFTM 


360 


*<./Pj=T« 


17n 


f f^ fM 


=lfiO 


FTT^ 


390 


FFTM 


^>00 



I N n L . . 

STRT. . 



JM 


= .1-1 , . 




i-FT« 4 7^ 




Di"; :■; --- 1 to km fiv ? 




FFTM 4I?C 




CO L -■< TO NT 


f*Y ."ll.. 


FFTM 490 




LJ -L + .JM,. 




FFT"1 "iC^ 




W- -Al 1,1 , . 


f^-M-fr-'-'CHArC-^ \(L1 WITH All-J! 


■^/F.-TW ^10 




W! -AtE+l), 


/■■^Mi',.' .M'. ■■ \ 1 WI"! '■. ■'.((;■'!; 


-/r-r-T'. '.;o 




A{L5 --A(LJ)t, 




FFT^ 530 




A(L*-l)-=AtL-''l 


f- 


FFTM 5*0 




A(LJ)=WR,. 




FFTM 550 




AUJ>LJ = riI,, 




FFTM ?ftO 




ENQ... 




FFTM '^TO 




f HO,. 




FfTw 580 






/«MtjnTEY P-MJ.-.'^eTEft .J tHO K 


*/FFTM 590 


K 


=NBM,, 




FFTM 600 




DO WHILE (J GT K), 




FFTM 610 




J ^J-K,. 




FFTM 6^0 




K =K./108,. 




FFTM 630 




END.. 




FFTM 640 


J 


^JtK,. 


/<^CGMPU!e NEW BIT REVERSAL 


*/FFTM 650 


ENO, 






FFTM 660 


NAD =NA+ 


NA,. 




FFTM 670 






/*TFST FOR 000 MJINDI 


«/FFTM 680 


IF NIN 1 T 


2 




FFTM 690 


THEN GO TO LEN^.,. 


/*M(INO) IS EVEN, NIN = I 


*/fFTM 700 


IF NIN= 2 






FFTM 710 


THEN 00 TO LEN2,. 


/*M( INO) IS ODD, NIN = 2 


*/FFTM 720 


NIN =NIN/1CCB,. 




FFTM 730 


GO ''O POO 




/****♦«*»»♦♦♦*♦***««**.,,*»***« 


**/FFTM 740 






/*TRANSFORM WITH LENGTH 2 


♦/FFTM 750 


00 I 


-^I TO NA BY 2,. 


/***♦*****♦***»*♦******+**», ^« 


*«/FFTM 760 




DC K ^( TO NT BY NAD,. 


FFTM 77C 




L =K+NA,. 




FFTM 780 




WF :^A)L),. 




FFTM 790 




Wl =AJL+1),. 




FFTM 800 




A(L) =A(KI-WR,. 


/*MOOIf-y AMD RESTORE ELEMENTS 


»/FFTM 810 




A(L+il-A(K+l)-WI,^ 




FFTM 820 




A { K ! ^ A ! K ) * WR , . 




FFTM 830 




A1XHI=A(S*1)+MI f . 




FFTM 84C 




END,. 




FFTM 850 


f NFj. 




/,***»*ti..;-***+«-tt#**»»**^, »**;(:«* 


♦♦/FFTM 860 






/*FAST FOURIER TRANSFORMS 


♦/FFTM 670 


MMAX ^N;>, 




/*SJ!T'"! LENGTH 4 


♦/FFTM 880 






,-.<*<-L<;*:^a(.*S:*********** ■»*•*»»• 


^♦/FFTM 890 


IF MMAX GE NBH 




FFTM 900 


THEN GO in MULTI,. 




FFTM 910 


f'M =M^<A 


■( + MMAX.. 




FFTM 920 


LMAX =MAX(NAO,f1M!iX/|09! ,. 




FFTM 930 


00 I 


=Nfl TO LMAX BV NAU, 


./♦EXECUTE LOOP FOR CALCULATION 


♦/FFTM 940 


J 


= 1,. 


/*0F ANGLES FOR SPECIFIC MMAX 


♦/FFTM 950 


IF M 


■lAX LE NA 




FFTM 960 


THEN 


GO TO INITL,. 




FFTM 970 


PI 


^-PI*J/HH, , 




FFTM 980 


IF {1PT='1' 




FFTPi 990 


Ti\i-H 


■= I ■= - R I , . 


/'rir.iNGE SIGW FOR C 'ICUi ST !0N 


*/FFTHlO0O 


VP. 


-'U'.I'U ),, 


/^V'-- EOiJR/FR SlRIT:'; 


*/rFTf«10lO 


^'. 


= ■; i N ( rt M , . 




FFT"1020 
FFT^nC30 


\I?U 


^WR*WP-WI*WI ,„ 


/ ■FO'i?-'irF COSINE AND SINE 


^/FFTMIO^O 


v;2i 


^,i;R*HI*10EtOO^.. 


-■'■ r; i; ,>*ai .-^jr; 3*ri 


^/FFTKIOSO 


H3R 


=W2R*WR-W2I*Wi ,. 




FFTM106C 


S!?I 


-H2f *WI+H2!«WR.. 




FFTMI070 






/*IN!TI A(.T.:r 1. AS INDEX FOR 


^/FFT^aoao 


1 


-I,. 


/'MUlTlOIr^t-MSIONAS >": ALCUL AT inNS*/FFTHlC'?0 








FFTMUOO 


IF MMAX= NA 


/•COMPUTE START VALUE KMIN FOR 


♦/FFT»11110 


THEN 


KHIN =r,. 


/■^TRANSFORMATION L0I!1' 


•■/FFTMU20 


ELSE 


K.Mirj =LtNl-i-'J, , 




fy-r!*\ 1^0 


Kr,]i 


■■'■HN''f"^AX-. 




F' ""Ml, 40 






/KO^^Pi'IE INCREMENT FOR TRF 


t/Errf.i_!=o 


K I Nt 


-■^■■ilE*100B,. 


/*IR;i.NSPORMAT!OM LOOP 


^VFF r-s! (60 




JO K -KMIN TO N"f BY 


lUNT. .. , 


FFT^mO 




K2 =K +KDIF,. 




FFTfiiHO 




K3 -K,:^KD1F,. 


/*K,K2,K3,K4 ARE PARAMETERS 


♦/FFTM1190 




K4 =K3+K01F,. 


/*FUR OPERATION WITH LENGTH 4 


*/FFTM1200 




IF MMax= NA 


/♦WITHOUT MULTIPLICATIONS 


*/FFTMl?K- 




TME'-J 00,. 




'"T-122': 



UlR =ACK1 


^A(K2),. 


FFTM1230 


UH =A(K+1) 


*A(K2*1I,. 


FFTM 1240 


U2R =A(K3) 


+AIK4),. 


FFTM1250 


U2I =A(K3+1)+A(K4H),. 


FFTM1260 


U3R =A(K) 


-fl(K2),. 


FFTM1270 


U3I =A(K-fl) 


-A(K2*1),. 


FFTM12eO 


U4R =A(K3+l)-A(K4+l),. 


FFTM1290 


U4I =A(K4) 


-A(K3»,. 


FFTM I 300 


ENO, . 




FFTM1310 


FLSE DO,. 




FFTHI320 


T2P =W2P*AIK2) -W21+A(K2+1),. 


FFTM1330 


T2I =W2R*A (t(2+ I )I-W2 1 ♦A(K2I,. 


FFTH1340 


T3R =WR *A(K3) -MI *A(K3+1),. 


FFTM1350 


T3I =WR «A(K3+n*HI *A(K3I,. 


FFTM1360 


T4R =W3R*A( 


■:4) -W3I*AtK4*l),. 


FFTM137C 


T4I =W3R^A(K4*U + H3I^A(K4), . 


FFTM1380 


UIK =A(K1 


^T2R,. 


FFTM1390 


Ull =A!K*l) 


►T2I,. 


FFTM1400 


U2R =T3R 


I-T4R,. 


FFTM1410 


U2I =T3I 


H4I,. 


FFTM1420 


U3R =A(K) 


-T2R,. 


FFTM1A30 


U3I =A(K.+ U 


-T2I,. 


FFTM 1440 


U4B =T3I 


-T4I,. 


FFTM1450 


U4I =T4R 


-T3R,. 


FFTM 1460 


END,. 




FFTM1470 


IF nPT= M' 


/*IN CASE OF FOURIER SERIES 


♦/FFTM1480 


THEN DO,. 




FFTH1490 


U4R =-U4R,. 




FFTM1500 


U4I =-U41,. 




FFTH1510 


END,. 




FFTM1520 


A(K) =Ulft+U2R,. 


/♦COMPUTE AND STORE NEW VALUES 


*/FFT«1530 


A(K:tll=LilH.U2I,. 




FFTM I 540 


A(K2)=U3R+UAP ,. 




FFTM1550 


fl(K2»-l)=U31*U4I,, 




FFTM 1560 


A(K3)=UIR-U2R,. 




FFTM1570 


A(K3*n=Ull-U2[ , . 




FFIK15SC 


a(K4)=U3R-U4R,. 




ef:TM^5g(- 


A(K4+1)=U3I-U4I,. 




FFTN!I6C0 


END,. 




FFTM161.0 


KMirj =L-KKMIN-L)^IC06, 


/♦UPDATE KMIN, KOIF ANO IF NEC 


-*/FFT'Al6Zr< 


KDIF =KINC, . 


/♦ESSARY REPEAT TRANSFORMATION 


*-/FFTMi630 


IF KDIF LE NBH 


/♦LOOP IN ORDER TO GET FINAL 


♦/FETM164C 


THEN GO TC [NCR,. 


/♦VALUES 


♦/FFTM1650 




/» 


♦/FFTM1660 


L =L+2,. 


/♦MODIFY L AND -IF NECESSARV- 


♦/FFTMI67C 


;F L it NA 


/♦START ANOTHER TRANSFORM 


♦/FFTM1680 


THFN GO TC STCT,. 




FFTM169C 




/♦ 


♦/FFTM1700 


J =JtLMAX,. 


/♦MODIFY J AND -IF NECESSARY- 


*/FFTM17K 


IF J LE MMAX 


/♦THE ANGLE 


♦/FFTM1720 


THEN 00, . 




FFTM173C 


TR =WR,. 


/♦IF Z = COSIRD ♦ I^SINIRI) 


♦/FFTM1740 


WR =(TR+WI)*BTH 


. /♦THEN Z IS SUBSTITUTED BV 


*/FrTM175G 


WI =(WI-TR)^RTH 


. /*Z = Z ♦ EXP(-PI/4 ♦ I) 


*/FFTM17eO 


IF QP7= •!• 




FFTM177C 


THEN DO,. 




FFTMITSC 


TR =WR,. 


/*Z IS SUBSTITUTED BY 


♦/FFTM 1790 


Wft =-WI,. 


/♦Z = Z * EXP(*Pl/4 ♦ U 


♦/FFTMlflOG 


WI =T0,. 




FFTW181C 


END,. 




FFTM182C 


GO TO DOUBLE,. 




FFTM1830 


END,. 




FFT«ie40 


END, . 




FFTM185C 


NIN =3-NIN,. 


/♦UPDATE NIN AND 00U8LE MMAX 


*/ FFTM 1860 


MfAX =MM, . 




FFTM187C 


GU TO MAIN, . 




FFTMieeo 


MULTI .. 




FFTM189C 


^.'A =NB, .. 




FFTM1900 


FNO, . 




FFTM1910 


ERROR^'O" , . 


/♦SUCCESSFUL FOURIER TRANSFORM 


*/Ff IM1920 


RETURN. . 




EFTM1930 


END, . 


/♦END OF PROCEDURE FFTM 


♦/FFTM194C 



Purpose: 

FFTM performs finite, multidimensional Fourier 
forward or inverse transformations for complex 
arrays whose dimensions are powers of two. 

Depending on the value of the input parameter 
OPT, the following transformations can be done: 



OPT = '0' 
OPT = '1' 

Usage: 



forward Fourier transform 
inverse Fourier transform 



CALL FFTM (A, M, NDIM, OPT); 

A(21^V^2-MnDIM)- 

BINARY FLOAT [(53)] 

Given one-dimensional real array used 

to hold the complex multidimensional 

array A(Ni, Ng, . . . , %dim) to be 

transformed. 

The real and the imaginary parts of a 

data element must be placed by pairs 
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into immediately adjacent locations in 

storage. Note that the last subscript 

increases most rapidly. 

Resultant complex Fourier transform in 

the same storage order. 

The number of elements of vector A is 

„1+M +M„ 

M 

M(NDIM) - BINARY FIXED 

Given integer vector of length NDIM, 
which determines the Kctent of each 
dimension of complex array A(Ni, N2, 

Nndim)= 

N -2^^^> N=2^<2) N 



NDIM 



OPT - 



Remarks: 



_ M(NDIM) 

BINARY FIXED 

Given number of dimensions of 

multidimensional array A. 

CHARACTER (1) 

Given option parameter for selection of 

transform. 



Procedure FFTM is to be used for Fourier trans- 
forms of complex, multidimensional arrays in which 
each dimension is a power of two: 

N = 2^^*^^ with V = 1,2,...,NDIM 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. 

Error parameter ERROR='P' is returned if 
NDIM < 1 or any Ni; < 1 . 

A forward transform followed by an inverse 
transform, returns the original data multiplied by 
Nj • Ng* . . . N]s^j]y[ (except for roundoff errors). 

Method: 

Calculations performed are based on the Cooley- 
Tukey Fast Fourier transform. 

For reference see: 

J. W. Cooley, P. A. W. Lewis, P. D. Welch, "The 
Fast Fourier Transform Algorithm and its Applica- 
tions", IBM Research, RC 1743, February 9, 1967, 
pp. 15-30. 

N. M. Brenner, "Three Fortran Programs that 
Perform the Cooley- Tukey Fourier Transform", 



Lincoln Laboratory, Massachusetts Institute of 
Technology, Lexington, Technical Note ESD-TR- 
67-462, 1967. 

J. W. Cooley and J. W. Tukey, "An Algorithm for 
the Machine Calcvdation of Complex Fourier Series", 
Mathe matics of Computations , vol. 19, 1965, pp. 
297-301. 

Mathematical Background 

The normal algorithm 

Let B(nj^,n2 njj be a complex multidimensional 

array whose dimensions are powers of two: 

N^ =2^<^). V = 1.2,...,L 

The finite Fourier forward transform of B is defined 
as 

1 Ni-1 



A(k^,...kj^) N-N-...N 



L n =0 



Nl-1 



n =0 
L 

-nl-k. 



(1) 



• W, 



■W. 



'^l'^l 



where: 



W = exp/'— \andl =^^i^ 
^ \\) 

Similarly, B(ni n^) can be expressed as the 

finite Fourier inverse transform (or Foiurier series) 
of A(kj^ kL). 



N^-1 


N^-1 


E - 


E 


k =0 


k^=0 



• W, ^ ^ • . . . • W, ^ 

1 L 



The innermost sum yields an array 



(2) 



N^-1 



^j(kj^ ^L-l'^^L^ " ^ A(kj^,...,kj^) 



kj^=0 



W. 



+kL-°L 



(3) 
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Since equation (3) is equivalent to a one-dimensional 
problem, we discuss now the algorithm for one- 
dimensional complex Fourier transform. 



Then, summation over kj^^.g, to get an array A2 
from Ai, and so on, leads to the general foirmula 
(L = 1,2,...,M): 



N-1 



XW- E A„.W^-°, W^ = «<p(f) 



k=0 



(4) 



Since N = 2^, we express X(n) as a function of the 

M arguments iim-1>iim-2' • • '^^l' ^^0 °^ ^^ binary 
representation of n: 



1 

^ .Vl^ V2'Vl'Vl-1, 



'^M-L=« 



„M-1 M-2 

n = n , • 2 +n • 2 
M-1 M-2 



'^I'V 



+. . . +n^. 2+n^; n^ = or 1. 

Analogously, if 

, , „M-1^, M-2 



+ k/2 +k- ; k = or 1 
1 v 



then equation (4) can be written: 
^^%-1'''m-2""W = 



k^o"'k^=0 '^^M-l''^M-2 k^'V 



W, 



/I oM-l 

n-(kj^_^-2 +...+k^.24kQ) 



N 



Using 



„2M_ „N 

vV^, = W = 1, we have 



(5) 



W, 



(vr2'^"'+"--^v'^V* Vl*2 



N 



M-L 



(6) 



N N 



The final array will be the desired X. The storage 
indexing convention used here is to let the M argu- 
ments of A^ (nQ, . . . , kg) be the binary representa- 
tion of the index of the storage location for AL(nQ, 
.... kg). In this way, each step of the algorithm 
involves fetching from two storage locations and 
returning results in the same two locations, thereby 
saving storage. However, the elements of the final 
array are in wrong order: 

^^°M-r°M-2"--'VV = V ("o'V-'-'^^M-i^ 

Now, we must reverse the order of the bits in the 
binary representation of n. FFT does the reordering 
on the initial array so that the result is in the cor- 
rect order. 



n-k,^ .2^-1 n.k .2^-1 

M-1 ^0 M-1 

N "^N 



Therefore the innermost smn in equation (5) yields 
an array: 



V%'V2 ^I'V 



The two-step algorithm 

A modification that achieves further economy at the 
expense of program complexity is to take two steps 
at a time when the Al in equation (6) are calculated. 
Let us define J as the index given by the high-order 
L-2 bit positions of an index and let K be the low- 
order M-L bit positions: 



= E A(k^_^.kj^_2,...,k^,k^) 
Vl^* 



^L^ VS' V2'^L-1' '^M-L-l k„). 

K 



•W. 



n„«k,, ,«2 
M-1 

N 



M-1 



Let: 



U = W. 



N 
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Then the step from L-2 to L-1, with 

2-^ f 

W^ = W^ = -1 



for k,, ^ = 1 

M-L 



A^_^ (0, 1) = Aj^_2(0, 1) • U + Aj^_2 (1, 1) • U 



is: 



Vi<'^'°'Vl'^>=V2<J'0'^M-L'K> 



^V2('^'^'Vl'^)-U 



Vi('^'^'Vl'^)=\-2('^'°'^M-L'^) 



(7) 



\-2<"^'1'Vl'^)-^ 



^°^Vl = 0'1- 



For the step from L-1 to L, we make use of the 
fact that 



w2 

N 



M-2 



N 

4 
= W = i and get: 



A^iJ,n^_^,0,K) = A^_^(J,nj^_2.0.K) 



.V2 



(8) 



A-i<"^'V2'^'^-^'''^"'-u 



forn^_2=0,l. 



Dropping J and K to simplify notation, we write 
equations (7) and (8) in a form that requires only 
three instead of four complex multiplications. To 
do this, let 



A^_^ (1, 1) = Aj^_2(0, 1) • U - A^_2 (1, 1) • U 



*°^ '^L-2 = ° (9) 



A^ (0, 0) = A^_^ (0, 0) + A^j (0, 1) 
Aj^(0,l) = Aj^_j(0,0)- Aj^_j(0,l) 



fornj^_2 = l 



^L <^' °> = ^L-1 <^' ^) "^ ^L-1 <^' ^> ' ^ 

^L <^' ^) " Vl <^' °> " \-l (^' ^> ' ' 

These equations are used for L = 2,4, 6, . . . ,M, if 
M is even. If M is odd, a single step is taken with 
L = 1 and equations (9) are used with L = 3, 5, 7, . . . 
M. 

The cases with J = and J = 1 are programmed 
separately to avoid multiplications: 



J = gives U = 1 



J = 1 gives U = W. 



2L-3 . ^M-L 

N 

N 



-"n-T-V?''*" 



and U = i, U^ =p (i-1). 
V2 



Vl<V2'^> = Vl<J'V2'l'^)*U 
Then, we have: 



for k,, ^ =0 

M-L 

\-l ^^'^> = \-2 ^°' °^ "" '^L-2(^' °^ ■ ^ 
\-l(^''^)=V2<*^'^>-V2<l'°>'u' 
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fHIM PtRfORMS flNITt, MULTIDIHEhSIONAl FOURIER TRANSFCRMS FOR COMPLEX ARRAYS, HHISF niMFNStONS ABE POICRS OF TWO 



****Al**# ****»• 
« * 

»Pi»iJCcOURe FFIH » 
* * 



»»*♦*& 1*******»*» 



PRESET 
£KROR="P> 



*«*»»•«♦»*•*♦»*** 



.*. 

CI *. 

.♦NUMBER *. 

rES .» ^ DIM OF ». 

...*.UlMcNSIONS IS.* 

*.L£SS THAN.* 

«. ONE .* 



« NO 



••«*#D1»** ******* 
» CALCULATE » 
» OIHENSIONS * 
• N( 1)=2**M( I) * 
» FOR * 

•I=lt2, ...,NDIH * 



.*. 
El *. 
.* TEST *. 
.*LlIHENSIONSi*. NO 
». IS ANY N( ll .*... 
*.LESS THAN.* 
». ONE .» 
* . .* 
* YES 

X 



*«««F 1*««*«**** 
» END OF • 

..X»PROCEOURE FFTH * 



*****A2 ********** 
*REORDER I NI Tl AL* 
*OATA ARRAY A BY* 
..X* 01 T REVFRSAL * 
. * TECHNIQUE * 
* • 



*«*«*B2 ********** 

* * 

* * 

* NAD =■ NA»NA * 

* * 
« • 
***************** 



C2 ». 

. * I S *. 
EVEN .* EXPONENT *. 
.*. HtINO) oon OR.* 
». EVEN .* 



,LEN2 X 

*****02 ********** 

* NIN =2, * 

* CALCULATE ONE * 

* FOURIER * 
*TRANSFORH WITH * 

* LENGTH TWO * 
***************** 



*»»««**«•«*««*« 



***« 

* * 

* Fl * 

* * 
**** 



***** Gl********** 

* COMPUTE TOTAL * 
*NUMBER OF TERMS* 
*NI=2*N(I1*N(2)*«X. 

* *...*N(NOIM) * 

* * 
***************** 



♦****Hl*** ******* 

* INITIALIZE * 

* INO=NOIM AS » 

* LOOP COUNTER • 

* FOR EACH * 

* DIMENSION * 
***************** 



*****J I********** 
*iET PARAMETERS * 

* FOR LOOP OVER * 

* DIMENSIONS *X.. 

* NIN=NIIN01 * 

* NB-NA*NIN * 
**»»»*****»****** 



LEN4 X 

*****E 2 ********** 
» NIN =1, * 

*INITIALIZE MAIN* 

* ROUTE SETTING * 

* HMAX = NA ♦ 

* * 
***************** 



F2 *. 

. »E NO OF *. 

.•MAIN LOOP. *. 

.X*.MMAX GREATER . 

*. THAN OR =. * 

». NB/2 . ♦ 



***** A3** ******** 

* * 
*CALCULATE LMAX * 

.X* AS MAXIMUM OF * 
*NAO AND MMAX/2 • 

* * 
**««*««********** 



•*«**B3 ********** 
*INITIALIZE UNA* 
*AS LOOP COUNTER* 
*FOR CALCULATION* 
•CF ANGLES FOR A* 
* SPECIFIC HMAX * 
***************** 



.«. 

C3 *. 

.*MULTI- *. 

.♦PLICATIONS *. NO 

..X*. NECESSARY, I6.*..X 

*. MMAX GI .* 

♦. NA .* 



***« 
i * 

> C3 « 



* YES 



* YES 



MULTI X 

♦♦♦**G2 ********** 



♦♦♦•♦♦•♦♦♦♦♦*«♦♦* 



♦♦♦♦4H2 ♦♦****•*** 

* * 

* DECREASE LOOP * 

* COLNTER INO. * 

* I ND=I ND-l * 

* * 
**♦*********»**•• 



J2 ♦. 

.•END OF ♦. 

NO .*IRANSFORH, *. YES 

. . . *. I.E. IS I NO .*.... 

*.LESS THAN.* 

*. ONE . * 
*. .* 



♦♦***03********** 

* * 

* COMPUTE ANGLE * 

* RI = * 
*-PI*I/(2*MMAXI * 

* * 
******•****♦***♦♦ 



♦♦♦♦♦E3*********» 
•CHANGE S IGN OF « 

* RI IN CASE OF * 

♦ INVERSE FOURIER* 
♦TRANSFORM, I.E.* 
•OPTION OPT=" !• * 
*******♦♦***♦•♦♦♦ 



•♦♦♦♦F3^^******** 

* * 

* CAtettLAT E * 
» WR-COSIRI) * 

* WI^SINIRII « 

* * 
***♦♦♦♦♦♦♦•♦♦**♦♦ 



* G3 *.X 



**** 
DOUBLE X 

♦♦♦♦♦G3 ********** 
*CCMPUTE COS INE • 
» AND SINE OF ♦ 
* DOUBLE AND * 
*TRIPLE ARGUMENT* 
*W2II,M2I,U3R,II3I* 
***************** 



♦♦♦♦•J34»4^^^^4*^ 

♦SET ERRDR='[)', * 

*I.E. SUCCESSFUL* 

.X* FOURIER • 

* T RANS FORM * 

♦ ♦ 
♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 



Kl ♦. 

.* IS *. 

.* INO-TH *. YES 

* .DIMENSION OF .*.... 

*. EXTENT .* 

*.NIN»1.* 

*. .* X 

* NO **** 

, ♦♦♦♦ ♦ ♦ 

. ♦ * * G2 * 

..X* A2 ♦ ♦ ♦ 

* * *♦♦♦ 

«♦*♦ 



INITL 

♦♦***A 4** ******** 
*INITIALIZE L=l * 

* AS INDEX FOR ♦ 
...X^ liUlTI- ♦ 

* 0I1ENSI0NAL ♦ 

* CALCULATIONS * 
«♦♦♦•****♦♦♦♦♦♦♦♦ 



STRT 

♦♦♦♦ ♦B it********** 

* COMPUTE START » 

*VALUE KM IN FOR * 
*TRANSFORMATION *X. 

* LDQP WITH • 

* LENGTH FOUR * 
•♦»*••♦•••**•♦*** 



INCR 

*****C it********** 

* CALCULATE ♦ 
♦INCREMENT KINC * 

. .X* FOR TRANSFOR- * 

* HATION L30P ♦ 

* KITH LENGTH 4 * 
♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 



♦♦♦♦♦D4^ ********* 

* INITIALIZE * 

*K=«HIN AS LOOP ♦ 

* COUNTER FOR * 
•TRANSFORMATION ♦ 

* LOOP * 
♦*♦♦♦**♦♦******♦* 



*****Zi,********** 

* CALCULATE * 

* INDFXES FOR * 
*OPERATIONS WITH* 

* LENGTH FOUR » 

* * 
****♦♦♦**♦***«*** 



*****f it********** 

♦ TRAMSFORM AND ♦ 

♦ RESTORE GIVEN ♦ 

♦ DATA AVOIDING • 
*MULTIPLICATIONS* 

♦ IF POSSIBLE ♦ 
♦♦♦•♦♦♦♦♦*♦♦*♦♦♦♦ 



♦♦♦♦♦GA*^*^*****: 

* 

♦ 

♦ K=K*KINC 

♦ 

♦ 

**************** 



X 
.♦. 

H4 *. 
.*END OF *. 
.*INNER LOOP,*. NO 
*.IE. K GREATER.*.., 
*. THAN NT .♦ 



*****J tf********** 

* * 

* * 

* UPDATE KM IN ♦ 

* * 

* * 
♦*******♦♦♦♦♦♦♦♦♦ 



NO .♦ FINAL *. 

. ..*. VALUES 

*. ATTAINED .♦ 



*****A5 ********** 



»«*♦*♦♦♦♦♦*♦***♦* 



B5 *. 
.*ANOTHER*. 
YES . * TRANSFORM *. 
....*. STARTEO, IE L.* 
*. LFSS THAN.* 
*. NA . * 
*. . * 
* NO 



NO . * NEW ». 

...*. ARGUMENTS . 

*. . * 



*****05********** 

♦ ♦ 

♦ UPDATE ♦ 

♦ PARAMETERS WR * 

♦ AND WI ♦ 

♦ ♦ 
♦♦••♦♦♦♦♦♦♦♦•♦♦♦♦ 



♦ ♦♦♦♦E 5 ********** 

♦ RESTORE AND ♦ 
♦CHANGE SIGN IN ♦ 
♦CASE OF INVERSE* 
♦TRANSFORM, !.£.♦ 

♦ OPT ='l' ♦ 
♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 

', ♦•♦♦ 



♦♦♦♦♦^^♦♦♦•♦♦♦♦^ 

♦ 
♦ 
X^ I = I* NAD 

♦ 
♦ 
♦♦♦♦♦♦♦♦♦♦♦♦♦♦*« 



. *. 

H5 *. 
. *E NO OF *. 

NO . *ANGLF-LQOP,*. 
...*.IF. I GREATER.* 
*. THAN LMAX.* 



♦ C3 ♦ 

♦ ♦ 
♦♦♦♦ 



♦♦♦♦♦J5 ♦♦♦♦♦♦♦♦♦♦ 

♦ ♦ 

♦ UPPATF ♦ 

♦ NI N'i-m N ♦ 

♦ MMAX=2^MMAX ♦ 

♦ ♦ 
♦♦♦♦**********♦♦♦ 

l *♦♦♦ 

♦ ♦ 
..X^ F2 ♦ 

♦ ♦ 
*♦♦♦ 
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• Subroutine APLL 



APLL.. 




APLL 


10 


/*****« 


***>!•********** f*»*»**Vt(*tt****^** *:*»****»**«« Vi».»*#if #i: ^if *if^ #»** t **/ l!tP\_l_ 


20 


/* 




*/flPLL 


30 


/* 


SET UP NORMAL EQUATIONS FOR 


A LINEAR LEAST SQUARES */APLL 


40 


/* 


FIT TO A GIVEN DISCRETE FUNCTIQt^ */APLL 


50 


/« 




*/APLL 


60 


/*♦«*»*****#*****#**<.*«**** *,**4«„***^<j=>^^<.^^,»«,»,^^**^^^*«;*^^^;^^^^,^,^^^^^p,^J_ 


70 


PROCEOUREIFCT.N.IP.HORK),. 


APLL 


eo 


0ECL4PE 


APLL 


90 




FCT ENTRY, 


APLL 


100 




(*(0RK(*),PUP+1),A,WGT) 


APLL 


110 




BINARY FLOAT, 


/^SINGLE PRECISION VERSION /*S*/APLL 


120 


/« 


BINARY FL0AT(53) , 


/'*D0U6LE PRECISION VERSION /*D*/APLL 


130 




(N.IP,LIP,IP1,I,J,K,L,M) 


APLL 


140 




BINARY FIXED, 


APLL 


150 




ERROR EXTERNAL CHARACTERd) 


APLL 


160 


ERROR='C' ,. 


/♦SUCCESSFUL OPERATION fr/APLL 


170 


LIP 


= IP,. 


APLL 


180 


IPl 


=LIP+1,. 


APLL 


1<J0 


n 


=IPl*tIPl*l)/2,. 


APLL 


200 




00 I =1 TO M,. 


/*1NIT. RIGHT HAND SIDE AND '/APLL 


210 




WORKU>=0,. 


/•COEFFICIENT MATRIX EQUAL 2:eRD*/APLL 


220 




END.. 


APLL 


230 


IF N 


GT 


/♦TEST SPECIFIED DIMENSIONS «/APLL 


240 


THEN 


IF LIP GT 


APLL 


250 


THEN 


IF N GT LIP 


APLL 


260 


THEN 


DO I =1 TO N,. 


/*FOf I-TH ARGUMENT */APLL 


270 






/♦PROVIDE VALUES OF GIVEN FCT.,*/APLL 


280 




CALL FCTn,N,LIP,P,WGT) ,, 


/♦HEIGHT AND FUNDAMENTAL FCT, ♦/APLL 


Z'iQ 




IF ERROR NE '0' 


AOLL 


300 




THEN GO TO OUT,. 


/♦EPPOfi IN PROCEDURE FCT. «/APLL 


310 




J =0,. 


APLL 


320 




DO K =1 TO IPl,. 


/♦COMPUTE COEFFICIENT MATRIX ♦/APLL 


330 




A =P(K)*HGT,. 


/♦AND RIGHT HAND SIDE ♦/APLL 


340 




DO L =1 TO K,. 


APLL 


350 




J =J*W. 


APLL 


360 




UORK(J)=MOftK(J) + PU)*A,. APLL 


370 




END,. 


APLL 


380 




END,. 


APLL 


3<)0 




END,, 


APLL 


400 


ELSE 


£RROR='0',. 


/♦ERROR IN SPECIFIED DIMENSIONS^/APLL 


410 


OUT.. 




APLL 


420 


END, 




/♦END OF PROCEDURE APLL «/APLL 


430 



Purpose: 

APLL sets up the normal equations for a poljmomial 
least squares fit to a given discrete function. 

Usage: 

CALL APLL (FCT, N, IP, WORK); 



FCT 



ENTRY 

Given procedure supplying the values 

of the fundamental functions, of the 

function that is to be approximated 

and of the weights. 

Usage: 

CALL FCT (I, N, IP, P, WGT); 

I - BINARY FIXED 

Given subscript value for 
current point. 

N - BINARY FIXED 

Given number of points. 

IP - BINARY FIXED 

Given number of fimda- 
mental functions. 

PaP+1) - BINARY FLOAT [(53)] 

Resultant vector containing 
values of fundamental func- 
tions, one up to IP, 
followed by value of func- 
tion that must be approx- 
imated for the i-th argu- 
ment. 

WGT - BINARY FLOAT [(53)] 
Resultant weight value 
for i-th argument. 



N - BINARY FIXED 

Given number of points. 

IP - BINARY FIXED 

Given number of fiuidamental 
functions, 

WORK(([P+l)(IP+2)/2) - 

BINARY FLOAT [(53)] 
Resultant vector containing the 
lower triangular part of symmetric 
coefficient matrix of normal equa- 
tions, stored rowwise, followed by 
right-hand side and square sum of 
function values. 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error condition 
that may be detected; 

ERROR='D' means error in specified dimensions IP, 
N — that is, IP is not less than N or N not greater 
than 1. 

For solving the normal equations, ASN may be 
used. 

If ERROR is set to a nonzero value within 
procedure FCT, control is returned to the calling 
program. 

Method: 

The normal equations stored in the vector WORK 
are obtained by minimizing 



N 



E^w(X^)[f(X^)-p(Xj^)] 



2 



where: 

w(Xjj)is the weight value for argument Xj^ 

f(X]j) is the value of the function to be approximated 

p(Xjj) is the value of the approximation function 

Mathematical Backgroxjnd: 

Let f(x), gi(x), i = 1, 2, . . , IP, and w(x) > be 

functions defined for x = x^, Xg, . . .x^ (the Xj may be 

vectors as well as scalars). 

The problem is to determine the coefficients C: 

IP ^ 

of the linear combination p(x) L Cjg^ (x) such that 

i=l 



N 



Zm^) (foy - P(xj^)) 



mm. 
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This problem leads to a system of linear equa- 
tions AC = R, where C is the vector of unknown co- 
efficients, A is the IP by IP symmetric positive 
definite matrix with elements 



N 



• Subroutine APC1/APC2 



^ik = S w(x.) g (X.) g^ (X.) 



i=l 



and R is an IP dimensional vector with elements 

N 



] 



= E w(x )f(X )g (X.) 
i=l •' 



(See ASN for details. ) 

Some remarks regarding polynomial approximation 
are in order. Use of monomials gi(x) =x^"-'- as 
fundamental functions results in a very badly condi- 
tioned coefficient matrix A. If Chebyshev or 
Legendre polynomials are used instead, the condition 
of the normal equations is improved remarkably, 
provided the arguments have a sensible distribution 
(for example, equidistant in the interval -1 to +1). 

Programming Considerations: 

To allow for full flexibility in data handling, the 
user must provide a procedure, described xmder 
"Usage". 

Coefficient matrix A and right-hand side R are 
stored adjacently. Within a linear array WORK, 
the lower triangular part of A is stored rowwise, 
followed by R, which is augmented by one element, ff , 
in which the weighted square sum of function values 
is returned. 

WORK = (aji, ai2, a22. • • • . a^jp, , . . , ajp ip , 
^1' • • ' np> ^ represents a triangular array. 

The described storage allocation of WORK is 
required by procedure ASN. The user has full 
flexibility for handling of the data 



X., f(x.), w (X.), g^ (X.) gjp (X.) 



1. If he wishes to allocate 



X., f(x.), w(x.), gj^(x.) 



gjp (X.) 



in main storage he may use external declarations. 

2. Calculation of some or all of the required 
quantities as functions of the subscript or as func- 
tions of the argument xj is another convenient choice. 

3. The needed data may be read in sequentially 
from one or more external devices. 

The three cases listed above may occur in any 
sensible combination. 



APCl.. 






APC 


10 


/**•*«« ******** «**«**ft******«««*««********««**********«««««t:«******* 


►♦/APC 


20 


/* 






*/APC 


30 


/* SET 


UP NORMAL EQUATIONS OF 


WEIGHTED LEAST SQUARES FIT IN 


*/APC 


40 


/* TERHS OF CHEBVSHEV POLINOMIALS FOR A GIVEN OESCPETE FUNCTION 


• /APC 


50 


/* 






♦ /APC 


60 




«*»>l>*«*«*»*****»****************i««*/Apc 


70 


PROCEOUPE(X.Y,W,N,IP,XO,X1,MORK) 


,, 


APC 


80 


DECLARE 






APC 


90 


1X( 


►t,Yl*),Hl*l ,XO,X1,MORK( 


*», 


APC 


too 


A.B 


C,TI,FI,SUM) 




APC 


110 


/* BINARY FLOAT153), 


/*D0U6LE PRECISION VERSION /*0*/APC 


130 


BINARY FLOAT, 


/'SINGLE PRECISION VERSION /* 


S'/APC 


120 


(Nt 


P,NN,LN,IP1,IPP,EPI, 




APC 


14C 


EP. 


EPE,I,K,KK,LtLL) 




APC 


150 


BINARY FIXED, 




APC 


160 


I TEST, ERROR EXTERNADCHARACTERl I ) , . 


APC 


170 


TEST ='1 




/^WEIGHTS ARE GIVEN 


♦ /APC 


180 


GO TO COMMON,. 




APC 


190 


APC2.. 






APC 


200 




***«*»*«««*«»*»***«**«*:* 


t-tf**«******^************************ / ttPC 


210 


/• 






♦ /APC 


220 


/* SET 


UP NORMAL EgUATIONS OF 


LEfiST SQUARES FIT IN TERHS OF 


*/APC 


230 


/» CHEBYCHEV POLYNOMIALS FOR A 


GIVEN DISCRETE FUNCTION 


♦ /APC 


240 


/* 






♦/APC 


2 50 






•♦/APC 


260 


ENTRYIX, 


f,N,IP,XC,Xl,WORK) ,. 




APC 


270 


TEST "'2 




/♦CONSTANT WEIGHTING ASSUMED 


*/APC 


280 


COHHON.. 






APC 


29C 


LN =N, 






APC 


300 


NN =LN 


fLN,. 




APC 


310 


IPP =IP+IP,. 




Apr 


320 


IPl =IP 


n.. 




APC 


330 


EP =(IP*IPl)/2,. 




APC 


340 


EPI =EP 


Ht. 




APC 


350 


6PE =EP 


UPl,. 




APC 


360 


ERRORS '0 




/♦PRESET ERROR INDICATOR 


♦ /APC 


370 


IF LN GT 


l' 


/♦TEST SPECIFIED DIMENSIONS 


♦/APC 


380 


THEN IF 


IPl GE 1 




APC 


39C 


THEN IF 


LN GE IPl 




APC 


400 


THEN DO, 






«PC 


410 


A,B 


=X(1),. 




APC 


420 




DP I =2 TO N,. 




APC 


430 




c =xn),. 




APC 


440 




IF C LT A 




APC 


450 




THEN A =C,. 


/*SET A TO INFIX(I)) 


♦/APC 


460 




ELSE IF C GT B 




APC 


470 




THEN B =C,. 


/♦SET B TO SUP(X(I)) 


♦/APC 


480 




END,. 




APC 


490 


XI 


=B-A,. 




APC 


500 


IF 


XI LE 




APC 


510 


THEN DO,. 




APC 


520 




ERRDR='A',. 


/♦ERROR RETURN FOR 


♦ /APC 


530 




GO TC OUT,. 


/♦DEGENERATE ARGUMENT RANGE 


♦/APC 


540 




END,. 




APC 


550 


XO 


=-(A+B)/Xl.. 




APC 


560 


XI 


=2/Xl,. 




APC 


570 




DO I =1 TO IPP-1, 


/*INIT, RIGHT HAND SIDE AND 


♦ /APC 


5 BO 




EPI TO EPE-1,. 


/♦MORKING STORAGE 


*/APC 


590 




WORK (11=0,. 




APC 


600 




END,. 




APC 


610 


SUM 


=0.. 


/*INIT. SQUARE SUM OF FCT.VAL. 


♦ /APC 


620 




00 I -:! TO LN,. 




APC 


630 




TI =X1*X(I)+X0,. 


/♦TRANSFORM ARGUMENT TO (-1.1) 


• /APC 


640 




A =1,. 




APC 


650 




IF TEST=*1' 


/♦SHOULD HEIGHTS BE USED, THEN 


*/APC 


660 




THEN A =U<I),. 


/♦SET A TO I-TH HEIGHT 


•/APC 


670 




B =TI»A,. 




APC 


68 C 




FI -Yd),. 


/♦SET FI TO FUNCTION VALUE 


♦ /APC 


690 




SUM =SUM+FI«Fi*A,. 


/♦UPDATE SQUARES SUM 


• /APC 


700 




FI =FI+FI,. 




APC 


710 




00 L -1 TO IPP-1, 


. /♦UPDATE RIGHT HAND SIDE AND 


• /APC 


720 




C =A,, 


/♦WORKING STORAGE 


•/ABC 


730 




LL =L,. 




APC 


740 


REP.. 






APC 


75C 




HORKtLL)«WOfiK(LL) 


+C,. 


APC 


760 




IF LL LE IP 




APC 


770 




THEN DO,. 




APC 


780 




LL =EP+LLt 




APC 


79C 




C =C«FI,, 




APC 


BOO 




GO TO REP.. 




APC 


810 




END.. 




APC 


82C 




C =TI*B,. 




APC 


830 




C =C-A*C,. 




APC 


84 G 




A =B.. 




APC 


850 




B =€,. 




APC 


860 




END,. 




APC 


870 




END,. 




APC 


880 


LL 


=EPl,. 




APC 


890 




DO K =IPP TO 2 BY -2.. 


/♦COMPUTE COEFFICIENT MATRIX 


• /APC 


900 




L =1.. 




APC 


910 




KK =K,. 




APC 


920 


STORE.. 






APC 


930 




LL =LL-1,. 




APC 


940 




KK =KK-l,. 




APC 


950 




WORK! LL ) =MORK( KK ) *HORK ( L ) , . 


APC 


960 




L =L+U. 




APC 


970 




IF KK GT L 




APC 


980 




THEN GO TO STORE,. 




APC 


990 




END,. 




APC 


1000 


HORK(EPE)=SUM*SUM,. 


/♦INSERT SQUARE SUM DF FCT.VAL 


.♦/APC 


1010 


ERO 


QR='C',. 


/♦SUCCESSFUL OPERATION 


♦ /APC 


1020 


END 






APC 


1030 


OUT.. 






APC 


104C 


END,. 




/♦END OF PROCEDURE APC 


•/APC 


1050 



Purpose: 

APC1/APC2 sets up the normal equations for a 
polynomial least squares fit to a given discrete 
function, ixsing Chebyshev polynomials as funda- 
mental functions. 
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Usage: 

CALL APCl (X, Y, W, N, IP, XO, XI, WORK); 

X(N) - BINARY FLOAT [(53)] 

Given vector of argument values. 
Y(N) - BINARY FLOAT [(53)] 

Given vector of function values that 

are to be approximated. 
W(N) - BINARY FLOAT [(53)] 

Given vector of weighted values. 
N - BINARY FIXED 

Given number of argument values. 
IP - BINARY FIXED 

Given number of Chebyshev 

poljmomials. 
XO - BINARY FLOAT [(53)] 

Resultant additive constant for linear 

transformation of argument range. 
XI - BINARY FLOAT [(53)] 

Resultant multiplicative constant for 

linear transformation of argument 

range, 
WORK((IP+l)(IP+2)/2) - 

BINARY FLOAT [(53)] 
Resultant vector containing the lower 
triangular part of symmetric co- 
efficient matrix of normal equations, 
stored rowwise, followed by right- 
hand side and square sum of function 
values. 

CALL APC2 (X, Y, N, IP, XO, XI, WORK); 

X(N) - BINARY FLOAT [(53)] 

Given vector of argument values. 

Y(N) - BINARY FLOAT [(53)] 

Given vector of function values that 
are to be approximated. 

N - BINARY FIXED 

Given number of argument values. 

IP - BINARY FIXED 

Given number of Chebyshev poly- 
nomials. 

XO - BINARY FLOAT [(53)] 

Resultant additive constant for linear 
transformation of argument range. 

XI - BINARY FLOAT [(53)] 

Resultant multiplicative constant for 
linear transformation of argument 
range. 

WORK((IP+l)(IP+2)/2) - 

BINARY FLOAT [(53)] 
Resultant vector containing the lower 
triangular part of symmetric co- 
efficient matrix of normal equations. 



stored rowwise, followed by right- 
hand side and square sum of function 
values. 



Remarks: 



1. If no errors are detected in the processing of 
data, the error indicator, ERROR, is set to zero. 
The following constitutes the possible error condition 
that may be detected: 

ERROE?=' D' means error in specified dimen- 
sions IP, N ~ that is, for IP not less than N or N 
not greater than 1. 

2. APC2 implies constant weighting (value one). 

3. The use of Chebyshev polynomials instead 

of monomials results in a remarkable improvement 
of the condition of the normal equations , provided 
the arguments have a sensible distribution (for 
example, equidistant). 

4. The given argument range is reduced by means 
of the linear transformation. 

t(x) = X- • X + X. 

to the reduced range -1 ^ t(x) s + 1. The normal 
equations are set up for Chebyshev expansions in 
t(x) and the solution of these equations is determined 
by procedure ASN. This is no disadvantage, since 
the Chebyshev expansion may be evaluated effectively 
for a specified'argument x using procedure POSV 
with argument t = x • x^ + kq and the calculated 
coefficient vector of the Chebyshev expansion. 

5. The transformation ofthe calculated Chebyshev 
expansion to an ordinary polynomial may be ac- 
complished using procedure POST. 

Method: 

The polynomial fit is calculated in the form of iis 
Chebyshev expansion. 

C^T^(t) + C2T^(t) + ...+CjpTjp_l(t) 

where Tj^ (t) is the Chebyshev polynomial of degree k. 

The values of the Chebyshev poljmomials for the 
argument t are calculated by means of the three- 
term recurrence equation: 

Tj^ (t) = 2 t Tj^_^ (t) - Tj^_2 (t); k>2 

with starting values Tq (t) = 1, Tj^ (t) = t. In setting 
up the coefficient matrix, time is saved by using the 
identity 



2Tj-T, = Y,+ T| . 
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Mathematical Background: 

Let XL and x^ denote the leftmost and rightmost 
arguments respectively. By means of the linear 
transformation 

2x-(Xj^ + x^) 



t(x) = 



= X, 



X + X. 



■^R 



the argument range x^ ^ x ^ X|^ is reduced to the 
argument range -1 s t(x) £■ +1. 

The function f(x), given for x = xj, X2 x^, 

is to be approximated by an expansion in Chebyshev 
polynomials: 



in severe loss of accuracy. Therefore, no attempt 
is made to return the polynomial expansions. 

Programming Considerations: 

Only the lower triangular part of the symmetric co- 
efficient matrix is generated and stored rowwise, 
followed immediately by the right-hand side and by 
the weighted square siun of function values. 

This storage allocation scheme is required by 
subroutine ASN, which may be used for calculation 
of the normal equations. 



IP 



P(x) = E C T (t(x)) 
^ 



so that 

N 



E w(x) [f(x)-p(x)]' 
i=l 



= mm. 



Tj^ (t) is the Chebyshev polynomial of degree k. 
The vector C of unknown coefficients C^ is a 
solution of the matrix equation AC = R, where A is an 
IP by IP symmetric positive definite matrix with 
elements 



]k 



N 

= E 

i=l 



w(x.) 



J-1 



(t(x.)) 



k-1 



(t(x.)) 



and R is a vector of dimension IP with elements 

N 
rj = E w(x.) T._^ (t(x.)) f(x.) 



i=l 



(See ASN for details.) 

The Chebyshev expansion of the polynomial p(x) gives 
a much better indication of the accuracy ctf the ap- 
proximation than the coefficient vector of the poly- 
nomial itself. If the specified degree of the poly- 
nomial is too high, the last terms of ihe Chebyshev 
expansion are uniformly small compared with the 
preceding coefficients. The degree might be reduced 
by the number of small trailing coefficients without 
unduly enlarging the overall error. 

An upper boimd for the error introduced by ne- 
glecting the last terms of the Chebyshev expansion 
is given by the sum of the absolute values of these 
terms. Normally, transformation of the Chebyshev 
expansion in t(x) to ordinary pol5momials in x results 
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• Subroutine ASN 











ASN.. 




ASN 


IC 


/*«•«*«*«♦**•*****•«****♦***•*«**<-*** 




• /ASN 


20 


/* 




♦ /ASN 


30 


/• SOLUTION OF N0RMAL-E0UAT10r4S 


UP TO SPECIFIED ORDER 


♦ /ASN 


*0 


/* OP Pt^ECISION. 




♦ /ASN 


5C 


/* AU FITS Of SMALLER ORDER ARE 


CALCULATED OPTIONALLY. 


♦ /ASN 


60 


/* 




♦ /ASN 


70 


/«««**«****«« «*«*i***«>0<« »«*«*»«*«« Ik*** 


»«>:>«[*«««*«** **«**« wi*«**s******** 


*/ftSN 


8C 


PROCEDURE { WORK, I P. 1 RES, OPT, EPS t ETA),. 


ASN 


90 


DECLARE 




ASN 


IOC 


S aiNARY FLOAT! 53), 




ASN 


110 


(Wf^Rm*),EPS,eTA,TPLtTEST, 




a<;n 


120 


AUX(IP),ME,O.P} 




ASN 


130 


BINARY FLOAT, 


/♦SINGLE PRECISION VERSION /*S*/ASN 


140 


/* BINARY FLrAT(53) . 


/*DnU6LE PRECISION VERSION /«0*/ASN 


150 


UPtlPl.RS.OG.DDG.L.LL. 




ASN 


160 


EPE,LLL,DL,IPR,IRES,K,EP. 




ASN 


170 


1,II,LL1,CLKI 




ASN 


180 


BINARY FIXED, 




ASN 


190 


(OPT, CHECK, ERROR EXTFRNAll 




ASN 


200 


CHARACTER 11),. 




ASN 


210 


IF ETA NE C 


/*PRESET EPROP INDICATOR 


♦/ASN 


220 


THEN CHECK:>*A'.. 


/*A= ACCURACY NOT REACHED 


♦ /ASN 


230 


ELSE CHECK='0',. 


/*C= SUCCESSFUL OPERATION 


♦ /ASN 


240 


IPl =IP+l.. 




ASN 


2 5C 


IF IPl LE 1 




ASN 


260 


THEN DO,. 




ASN 


270 


CHECK='0',. 


/*ERRnfi IN SPECIFIED DIMENSION 


♦/ASN 


280 


GO TO OUT,. 




ASN 


290 


END,, 




ASN 


3C0 


EP =lP*IPl/2,. 


/♦SET UP ADDRESSING CONSTANTS 


♦ /ASN 


310 


EPE =EP+IP1,. 




ASN 


320 


WE =WORKIEPE),. 




ASN 


330 


IF CHECK='A* 


/*SET TEST TO ABSOLUTE VALUE nF«/ASN 


34C 


THEN TEST =AbS(ETA«HEI,. 


/•SPEC. ACCURACY FOP WANTED FIT'/ASN 


350 


1PR,LL=C.. 




ASN 


■560 


L,LLl-l,. 




ASN 


370 




/««*♦«*****»****•«***♦****••«"* 


**/ASN 


360 


DO I =1 TO IP,. 


/♦FACTORUE GIVEN MATRIX 


♦ /ASN 


390 


LL =LL+I,. 


/»*«*«*****«**♦ «*1'« «*««««*«««« 


•*/ASN 


400 


K =0,. 




ASN 


410 


ITER.. 


/♦COMPUTE ELEMENTS O-: I-TH ROW 


*/ASN 


420 


S =0,. 




ASN 


430 


DO U = LL1 TO LL-1,. 


/♦MODIFY ELEMENTS IN I-TH 


♦ /ASN 


440 


S =S+MULTIPLY( 


/*ROW BY SCALAR PRODUCT Of 


♦ /ASN 


450 


WORKdU, 


/♦ELEMENTS OF FACTORIZATION 


«/ASN 


460 


W0RK(L).53),. 


/•IN ROM AND COLUMN CROSSING 


♦/ASN 


470 


L =L*1t. 


/♦AT CURRENT ELEMENT 


♦ /ASN 


ifiO 


END,. 




ASN 


490 


R =WCRK(L),. 




ASN 


50C 


s =p-s,. 




ASN 


510 


IF L ^LL 


/♦TEST FOR LOSS OF SIGN If ICANCE^/ASN 


520 


THEN DO,. 


/♦IN PIVOTAL DIVISOR 


♦ /ASN 


530 


IF S LE A6S(EPS*R) 




ASN 


540 


THEN DO,. 




ASN 


550 


CHECK=.'P',. 


/♦MARK LOSS Of SIGNIFICANCE 


♦ /ASN 


560 


GO TO SOL,. 


/♦BYPASS FURTHER FACTOP IZATION 


♦ /ASN 


570 


END,. 




ASN 


5 80 


«,S =SaRT(Sl,. 


/♦CALCULATE DIAGONAL ELEMENT 


♦ /ASN 


59C 


END.. 


/♦OF FACTORUATION 


♦ /ASN 


600 


ELSE S =S/0,. 




ASN 


610 


WORKIL)=S,. 


/♦STORE FINAL ELEMENT 


♦ /ASN 


620 


K =K*1,. 


/♦OF FACTORIZATION 


♦ /ASN 


630 


L =L+K,. 




ASN 


640 


IF Ktl LE IPl 


/*TEST IF ALL ELEMENTS OF I-TH 


♦ /ASN 


650 


THEN GO TO ITER,. 


/♦ROW ARE COMPUTED 


♦ /ASN 


660 


LLl,L=LL+l,. 




ASN 


670 


WE =we-s*s,. 




ASN 


680 


AUX(n = WE,. 


/♦STORE SQUARESUM OF RESIDUALS 


♦ /ASN 


690 


IF CHECK='fi' 


/♦TEST ON SPECIFIED PRECISION 


♦ /ASN 


700 


THEN IF WE LT TEST 




ASN 


710 


THEN DO,. 




ASN 


720 


CHECK='0',. 


/♦SUCCESSFUL OPERATION 


♦ /ASN 


730 


GO TO SOL,. 


/*RESP. ETA ACCURACY PEACHED 


♦/ASN 


740 


END,. 




ASN 


750 


IPC =IPP*1,. 




ASN 


760 


END,. 


/♦END OF FACTORIZATION 


♦ /ASN 


77C 


IF OPT='F' 




ASN 


780 


THEN GO TO OUT,. 




ftSN 


790 


LL =EPE,. 


/*»**»*»***♦*****»**«********* 


♦♦/ASN 


800 




/♦COMPUTE LEAST SQUARE FIT(S) 


♦ /ASN 


810 


SOL.. 


/*****#*»♦*♦*************»««** 


♦♦/ASN 


820 


RS -EP*IPR,. 


/♦INIT. ADDRESS RIGHT HAND SIDE^/ASN 


830 


DG =LL-1-IPR,. 


/♦INII. ADDRESS DIAGONAL TERM 


*/ASN 


840 


00 I =IPP TO I BY -1,. 




ASN 


850 


=HORK(DG),. 


/♦SET Q TO I-TH DIAGONAL TERM 


*/ASN 


860 


R =MDfiK(RS],. 


/♦SET R TO I-TH RIGHT HAND SIDE*/ASN 


870 


M0RK(CS)=AUXII) ,. 


/♦INSERT I-TH RESIDUAL 


*/ASN 


880 


RS =RS-1,. 




ASN 


890 


DG =DG-I,. 




ASN 


900 


LL,L =LL-1,. 




ASN 


910 


K =IPR-I,. 




ASN 


920 


OL,DLK=IPR,. 




ASN 


930 


REP.. 


/♦CALCULATE THE I-TH ELEMENT 


♦ /ASN 


94C 


L,LLL=L-DL,. 


/♦FOR THE HIGHEST FIT AND 


♦ /ASN 


950 


OL,OLK=DL-l,. 


/♦OPTIONALLY OF ALL LOWER FITS */ASN 


960 


S =0,. 




ASN 


970 


00 1I=L*K TO L+1 BY -1 


. /♦FORM SCALAR PRODUCTS NEEDED 


♦ /ASN 


980 


S =S+MULTIPLY( 


/♦WITH BACK SUBSTITUTION 


*/ASN 


990 


WORKILLL), 




ASN 


1000 


W0RK(1I),53),. 




flSN 


1010 


LLL =LLL-DLK,. 




ASN 


1020 


DLK =0LK-1,. 




ASN 


1030 


ENO,. 




ASN 


1040 


WOBK{L)=(P-S)/0,. 




ASN 


1050 


K -K-1,. 




ASN 


1060 


IF OPT='A' 


/♦REPEAT IF ALL fITS SHOULD 


*/ASN 


1070 


THEN If K GE 


/♦BE, CALCULATED 


♦/ASN 


1C80 


THEN GO TO REP,. 




ASN 


1090 


END,. 




ASN 


1100 


ruT.. 




ASN 


1110 


IRES =IPR,. 




ASN 


1120 


£RROR=CHECK, . 




ASN 


1130 


END,. 


/♦END OF PROCEDURE ASN 


*/ASN 


1140 



Purpose: 

ASN computes the solution of normal equations set 
up by procedures APCl, APC2, and APLL. 



Usage: 

CALL ASN (WORK, IP, IRES, OPT, EPS, ETA); 

WORK ((IP+1) (IP+2)/2) - 

BINARY FLOAT [(53)] 
Given vector, containing the lower 
triangular part of a symmetric co- 
efficient matrix of normal equations, 
stored rowwise, followed by the 
right-hand side and the square sum 
of function values. 
Resultant vector containing (se- 
quentially) the coefficient vectors 
of computed least square fits, 
degree one up to IRES. 

WORK((IP(IP+l)/2) + K), K=l 

IRES contains the residuals cor- 
responding to the approximation fit 
of degree K. 

If only the approximation fit of 
highest degree (that is, degree 
IRES) is calculated, the coefficient 
vector has the same storage alloca- 
tion as if all fits were calculated 
(similarly for the corresponding 
residual vector). 

IP - BINARY FIXED 

Given number of fundamental fvmc- 
tions. 

IRES - BINARY FIXED 

Resultant (higjiest) degree of ap- 
proximation fit(s) with respect to 
the user-specified accuracy. 

OPT - CHARACTER(l) 

Given option for operations to be 
performed. 

EPS - BINARY FLOAT [(53)] 

Given relative tolerance for tefai on 
loss of significance. 

ETA - BINARY FLOAT [(53)] 

Given relative tolerance for tol- 
erated square sum of residuals. 

Remarks: 

1. All operations are performed with respect to 
the user-specified tolerances EPS and ETA, 

2, If OPT is not equal to 'A' or 'F', then ASN 
computes the least square fit of degree IRES only. 
OPT='A' means all fits of degree one up to IRES are 
calculated. 

OPT='F' means the given coefficient matrix A is 
factored in the form T*T, in the linear array WORK. 
The triangular matrix T is allocated in the same way 
as the upper (lower) triangular part of A, The right- 
hand side R is replaced by (T*)"-'-R. 
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3. For EPS a sensible value is between 10"3 and 
10-6 (10-10 and IQ-l^) jq single (double) precision. 
The absolute tolerance used internally for the test 
on loss of significance is ABS (EPS times current 
pivotal element). 

For ETA a realistic value is between 1 and 10-6 
(1 and 10-15) in single (double) precision. Never- 
theless, ETA may be set equal to zero. If no 
specification is made for ETA, it is equivalent to 
setting ETA=0. The absolute tolerance used in- 
ternally for the square sum of residuals is ABS 
(ETA times square sum of function values). 

4. Let: 

nj = maximal dimension for which no loss of 
significance was indicated during factor- 
ization 
n2 = smallest dimension for vs^ich the square 
sum of residuals does not exceed the 
absolute tolerance ETA 
IRES is given by MIN (ni, no, IP), (no = IP for 
ETA = 0), 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

5. ERROR='D' means IP is less than 1. 
ERROR='A' means respective ETA accuracy 

is not reached. 
ERROR=' P' means loss of significance was 
detected. 



form a system of m linear equations in m unknowns 

Ci. 

To simplify the notation we introduce the follow- 
ing matrices: 



X = 



F = 



f(Xj)" 



f (x ) 
n' 



W = 



w(x^) 



M^^K 



'w(x ) 
^ n' 



c = 



m 



G = 



gl(x,) . . g^(xj 



g^(Xj) . . g^(x^) 



Then we have 



T T T 

e = (F - C G) W(F - G C) 



Method: 



or, with eg = F WF, 



Calculation of the least square fits is done using 
Cholesky's square root method for sjonmetric 
factorization. 

Mathematical Background: 

Let f(x), gi(x), i = 1, 2, . . . , m, and w(x) > be 
functions defined for x = x^, X2, . . . , x^. The 
problem is to determine the coefficients Cj of the 
linear combination 



m 



p(x) = Lj c.g.(x) suea that 
i=l ^ ^ 



n 
V= ,?, w(x^) (f(xj^) - p(xj^))2 = „,in. 

K — X 



(1) 



The necessary conditions 
9e 



m 



'c. 
1 



= 0, i = l, 2, .. 



m 



(2) 



e = e„ - 2C GWF + C ''^GWG^C 
m 



(!') 



Using equation (l'), the equations (2) may be written 



GWG = GWF 



Combining (1') and (2') gives 



e. - e = C^GWG^C 
m 



(2') 



(3) 



The normal equations (2 ') for the unknown vector C 
may be solved using Cholesky's method since the 
coefficient matrix A = GWG'^ is obviously symmetric 
and it is positive definite if all the fundamental 
functions gj(x) are linearly independent for the argu- 
ments x^ -- that is, if the rows of G are linearly 
independent. Let R = GWF, Using Cholesky's 
method, A and R are replaced without additional 
storage requirements by T and (tI')-Ir, where 
A = t'^T and T is upper triangular. 
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An easy calculation shows 









T -1 


e = 


(T ) R 


m 





Introducing additional fundamental functions in 
the linear combination p(x) will not affect the first 
m rows and columns of A or the first m elements of 
R, Therefore, Cholesky's method gives a decom- 
position of Bq - e^ into the separate components 
corresponding to individual degrees of freedom. 

Programming Considerations: 

All least squares fits of dimension 1, 2, ... , m 

may be computed from the reduced normal equations 

T 1 
TC = (T )-■ ^R. If the solutions are generated in 

the storage locations of T, there is no additional 

storage requirement. 



Using the decomposition of eQ - e^^, the factori- 
zation may be terminated with dimension k if 
eij < T7eQ, giving the least squares fit of dimension 
k that satisfies the user-specified precision (rela- 
tive tolerance tj). Because of rounding errors this 
will work only if tj is approximately between 1. and 
1. E-6 in single precision, and between 1. and 1. 
E-15 in double precision. Nevertheless, the square 
sum of residuals corresponding to a least squares 
fit calculated in single (double) precision may be as 
small as eg lO'lS (qq IQ-SO), 

Because of rounding errors the square root 
method may break down if very small or negative 
pivot elements indicate a loss of significance. 
Therefore, all pivot elements are tested against the 
absolute value of EPS times the current diagonal 
element of A. If the k-th pivot element is not 
greater than this internal test value , the normal 
equations are treated as if they had dimension k-1 
only. 
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PROCEOURE ASN COMPUTES THE SOLUTION OF THE NCRHAL EQUATIONS SET UP BY OROCFOURES ABCl, APC2 ANtl APLL 



»*»*A1****»**** 

• * 

* PROCEDURE ASN • 
« « 



NU .* IS ETA 
. ..*. UNEQUAL ID 
• . ZERO 



*#***C1*»******** 

•iET ERROR ='A> *. 

* # 

* » 



* * 

* * 
.X'StT ERROR =«0" * 

* * 

* * 



NU .» NUMBER OF ». 
. ..«.fUNO. FCTS GE. 
». ONE .» 



*****F I*** ***♦•* 

« 

» SET UP 

* AOORESSING 

« CONSTANTS 

* 



•SET UP INTERNAL* 
» TOLtRANCE FOR t 

• TEST ON • 

• SPECIFIED • 

• ACCURACY » 



♦♦♦**A2»********* 

* INITIALIZE * 
♦CALCLLATION OF * 

X* THE CURRENT * 

* PIVOT ROW • 
» * 
******44**««***** 



B2 ♦. 
.•IS * 

PI VOT 

ELEMENT 

. ALMOST 

♦ .ZERO . • 

*. . * 

* NO 



«****B3 ******•#*« 

* * 

* ♦ 
.X«SET ERROR =■ P> *. 

* » 
» « 



*****C2 *♦♦******* 

* » 

* TRANSFORM THE • 

* CURRENT PI vol » 

* ROU ♦ 

* * 
***************** 



*****0Z********** 

* CALCULATE AND • 

* SICRE SQUARE * 

* SUM OF ♦ 

* RESIDUALS « 

* * 
***************** 



E2 *. 

. » I S *. 

.* ACCURACY * 

». REACHED, IF 

♦.SPECIFIED.* 



. ♦. 

F2 ». 

.♦ARE ALL^. 

♦ ROWS 

CALCULATED 



*****£i******t*** 

* * 

* * 
.X*SET ERROR ='0> ♦. 

• » 

♦ * 
***************** 



F3 ♦. 

.♦SHOULD *. 
.♦THE FITISr ♦. YES 
.X^.BE CALCULATED.*.. X 



♦♦♦♦♦G2^***^**^** 
» » 

* SET COUNTER FOR^ 
. ♦ CURRENT PI VOT * 

* ROW * 

* * 
♦♦♦*♦*♦*♦♦••*••♦* 



♦♦♦•♦J i*****«**«« 



.X»iET ERROR ='D' 



♦*••«•**♦**♦♦*♦♦* 



♦♦♦♦J2**^^^***^ 

♦ END OF ♦ 
,X* PROCEDURE ASN ♦X. 

♦ ♦ 
*************** 



SOL 

♦♦♦♦*A4^ *♦♦*«*♦*♦ 

• SET THF INDEX ♦ 

♦ FDR THE ♦ 
..x»COEFFICIENT OF ♦ 

♦ THE FITtS) ♦ 

* « 
♦♦*»***«♦♦♦«**»«» 



♦»***B4^ **♦**♦♦♦* 

♦ PREPARE THE « 
♦CALCULATIDN OF * 

♦ THESE ♦ 
» COEFFICIENTS ♦ 

♦ ♦ 
***************** 



*****Q t^********** 

♦ STDOE THF * 

♦ RESIDUAL FDR ♦ 

♦ THE FIT OF * 

♦ OEGRFF EQUAL TO* 

♦ INDEX ♦ 
***************** 



*****Di,********** 

♦ SET UP ♦ 

♦ ADDRESSING ♦ 

♦ CONSTANTS FOR ♦X.. 
♦CURRENT FLFMFNT^ 

♦ * 
****♦♦***«»*♦♦♦*« 



*****ft^********** 

* • 

• CO'IPUTE AND * 

* STORE CURRENT ♦ 

♦ ELEMENT ♦ 

♦ * 
**♦**♦♦*♦♦******♦ 



F4 ♦. 

.♦SHOULD ♦. 
NO .♦ALL FITS BE*. 
,..♦. CALCULATED .* 



.* IS *. 

.*COEFFICIFNT*. NO 
. CALCULATED . *. . . 
*. FOR ALL .* 
•.FITS .* 
*. .* 
* YES 



NO .* ARE ALL ♦. 
...♦.COEFFICIENTS .♦ 
♦.COMPUTED .♦ 



*****J It********** 

* STORE HIGHEST • 

* DEGREE OF * 
.♦ CALCULATED ♦ 

* FIT! SI ♦ 



***************** 



146 Mathematics — Approximation 



Smoothing of Tabulated Functions 
• Subroutine SG13/SE13 



SG13.. 




SG13 10 1 


/*«***»«**************«*****««*******«************«*«**«********«*****/SG13 20 1 


/* 




♦/SG13 30 


/* SMOOTH A TABLED FUNCTION USING 


♦/SG13 +0 


/* A FIRST OEGRee POLYNOMIAL FIT 


RELEVANT TO THREE POJNTS 


*/SG13 50 


/* 




♦/SG13 60 


/««************«»****««**»*«***********«****»«*«*«***************M**«/SG13 70 1 


PROCEDURE(X,Y,Z,DlM)t. 




S613 80 


DECLARE 




SG13 90 


(XC*),Y(*),Zt«'>.XA,XB*XCt 




S613 100 


YA,YB.YC,YM,TA,TB,TC»XH) 




SG13 110 


BINARY FLOAT, 


/*SINGLE PRECISION VERSION /*S*/SG13 120 1 


/* BINARY FL0AT(53I, 


/♦DOUBLE PRECISION VERSION /•DVSGI3 130 i 


(OIH.DBINARY FIXED, 




SG13 140 


SWITCH CHARACTER(l), 




SG13 150 


ERROR EXTERNAL CHARACTER{ 1) , . 




SG13 160 


SWITCH='G',. 


/*MARK GENERAL ARGUMENTS 


♦/SG13 170 


GOTO INIT,. 




SG13 180 


SE13.. 




SG13 190 


/it>«*««*4>*«««:***»«************«**«4:**i|i4[**««*«**««**«»«*«**«******tt*4<«i*«/SG13 200 1 


/• 




♦/SG13 210 


/* SMOOTH AN EQUIOISTANTLY TABLED FUNCTION USING 


♦/SG13 220 


/• A FIRST DEGREE POLYNOMIAL FIT 


RELEVANT TO THREE POINTS 


♦/SG13 230 


/♦ 




♦/SG13 240 


/*«* *«***««««***« ***«*****•«****«**«« 


«*******««****««««*****«*********/SGI3 250 1 


ENTRYCYt^.DIH),. 




SG13 260 


SHITCH='E',. 


/*MARK EQUIDISTANT ARGUMENTS 


♦/SG13 270 


INIT.. 




SG13 280 


IF DIM GE 3 


/♦TEST SPECIFIED DIMENSION 


♦/SGI 3 290 


THEN DO, . 




SG13 300 


YA =Yt3),. 


/♦MODIFICATION YA ^ YIOI 


♦/SG13 310 


YB =Y(1),, 




SG13 320 


IF SWITCH='G' 


/♦TEST GENERAL CASE 


♦ /S&13 330 


THEN DO,, 




SG13 340 


XA =XI3).. 


, ♦MODIFICATION XA = X(0) 


♦/SG13 35C 






SG13 360 






SG13 370 


ELSE YA =YB+(YB-YA)/2,. 


/♦MODIFICATION YA = Y(0» 


♦/SG13 380 


DO I - 2 TO DIM,. 




SG13 390 


YC =Y(I).. 




SG13 400 


YM =(YAtY6+YCl/3,. 


/♦SET YM TO ARITHMETIC MEAN 


♦/SG13 410 


IF SW1TCH='G» 


/♦TEST GENERAL CASE 


♦/SG13 420 


THEN 00,. 




SG13 430 


XC -XCI),. 




SG13 440 


IF (XB-XA)* 




SG13 450 


IXC-X8) LE 




SG13 460 


THEN ERROR=»M»,- 


/♦HARK NON-MONOTONIC TABLE 


♦/SG13 470 


XM =IXA+XB4-XCI/3, 




SG13 480 


TA =XA-XM,. 




SG13 490 


T6 =XB-XM,. 




SG13 500 


TC =XC-XM,. 




SG13 510 


XM =:TA*TA+TB*TBtTC*TC,. 


SG13 520 


IF XM GT 




SG13 530 


THEN XM =aA*(YA- 


YBl*- 


SG13 54C 


T6*(YB-YM)+ 




SG13 550 


TC«IYC-YM))/XM 


, . 


SG13 560 


aA =XB,. 




SG13 570 


X8 =XC,. 




SG13 560 


VM =XM*T8+YM,. 


/♦SET YM TO WEIGHTED MEAN 


*/SG13 590 


END,. 




SGI 3 60C 


Z(I-l)=YM,. 


/♦REPLACE Zll-U BY YM 


•/SG13 610 


YA =YB,. 




SG13 620 


YB -YC. 




SG13 630 


END,. 




SG13 640 


IF SMITCH='G* 




SG13 650 


THEN Z(DIM)=XM«ITC-T6)*YM,. 


/♦COMPUTE Z(DIM> GENEPAL CASE 


♦/SG13 660 


ELSE Z(0IH)=Y6+(YA-YM)/2,. 


/♦COMPUTE Z(DIM) EOUID. CASE 


*/SG13 67C 


ERROR-'O',. 


/♦SUCCESSFUL OPERATION 


♦/S613 680 


END,. 




SG13 690 


ELSE ERROR-'O',. 


/♦ERROR IN SPECIFIED DIMENSION 


♦/SG13 700 


END,. 


/♦END OF PROCEDUPE S13 


*/SG13 710 



Purpose: 



SG13, SE13 computes a vector Z = (z, , 



'DIM' 



of smoothed function values. SE13 requires a vector 
Y = (yj^, . . . , Ydim) and in the case of SG13 a vec- 
tor X = (xj , . . . , Xtjtj^) of argument values must be 
given in addition, y, corresponds to Xj, in the case 
of SE13 the y components correspond to equidistantly 



spaced argument values x. , assimiing x. 
Usage: 



CALL SG13 (X, Y, Z, DIM); 



X. 

1- 



= h. 



X(DIM) 



Y(DIM) 



BINARY FLOAT [(53)] 
Given vector of argument values. 
BINARY FLOAT [(53)] 
Given vector of function values . 



Z(DIM) 



DIM 



BINARY FLOAT [(53)] 

Resultant vector of smoothed 

function values. 

BINARY FIXED 

Given dimension of vectors X, Y 

and Z. 



CALL SE13 (Y, Z, DIM); 



Y(DIM) - 
Z(DIM) - 

DIM- 
Remarks: 



BINARY FLOAT [(53)] 

Given vector of function values. 

BINARY FLOAT [(53)] 

Resultant vector of smoothed 

function values. 

BINARY FIXED 

Given dimension of vectors Y, Z. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 



ERROR = 'D' 
ERROR = 'M' 



means DIM is less than three, 
indicates a non-monotonic argu- 
ment table, that is, for some i 

(^i"^i-l)(^i+l"Xi)» is less than or 
equal to zero. Vectors Z and Y 
may be identically allocated, which 
means that the given function 
values are replaced by the resul- 
tant smoothed function values. 



Method: 



The smoothed function values z. are obtained by 
evaluating the least squares polynomial of degree 
one at Xj^ relevant to three successive points. 

For references see: 

F, B. Hildebrand, Introduction to Numerical Analysis , 
McGraw-Hill, New York- Toronto- London, 1956, pp. 
258-311. 

Mathematical Background: 

For i = 3 n we must find m and b such that 

1 i 

wj (X) = m^x + b. (1) 

gives tive least-squares fit to the points (xi_2, yi-2)f 
(xi_i, yi-i), and (xj, yj). The problem, then, is to 
minimize 

F(m.,b.)=E[w.(x._^)-y._^] 
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This minimum will occur when 



and 



— r- = and — — = 
8b. 8m. 

1 1 



Now 
8F 

ab. 

1 
and 
9F 



H fw. (x. ) -y. 1 






-8^ = 2 £, Vk[Wk)-Vk] 

1 k=0 ■- -• 

Solving equations (2) and (3) yields: 



(2) 



(3) 



b. = y. - m. X. 
1 •'i 11 



Using (8) in (1) gives 



w.(x) = m.(x-x.) + y. 
r ' 1^ r •'i 



(8) 



where mj is as in (7), 

The desired smoothed values zj are given by: 



r. 



z. = 



i=< 



^3<^) = "^3*3,2 -^ ^3 "*=^ 



^+l<^i> = "^1+1^1,1*^1+1 '^'^^' 



.n-1 



(9) 



w (x ) = m t .+y if i=n 

^ n n n n, n 



l„v.v.W£^-y|„o 



m. 



k=0 ' " \k=0 ' "/ 



and 



b. =— y. I y. , - m.x. , 
1 3 , « I i-k 1 i-k 



k=0 



Letting: 



■1(4) 



(5) 



for generally tabulated argument values — that is, 
for SG13. 

In the case of equidistantly spaced argument 
values (that is, in case of SE13) we have the addi- 
tional relation xj - xj.i = h, a constant, for i = 2, 
. , . , n. This leads to the following expressions for 
the Zj[: 



^j(5yi+2y2-y3) 



i = 



z. = 



y(yj_i + yi + yj+i) 



-r(-y o+ 2y , + 5y ) 
L 6 ^ ■'n-2 ■'n-l •'n' 



if i=l 



if i=2,...,n-l 
(1) 

if i=n 



' ^ k=0 ^^ 



i 3 .■^^ i-k 
k=0 



t. , = X. , - X. and v. = y. , - y. 
i,k i-k 1 i,k i-k 1 



we may rewrite (4) and (5) as: 



(6) 



^ *i k ""i k 
i 2 



£ .^ 



k=0 



i,k 



(7) 
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Subroutine SE15 



For reference see: 



sei5.. 






SE15 


10 


/...,«. .»»»,«..,»«,..,.»»,„...,,,,,,.„,„,,,„,,„,,,,„,,„,,,,„„,5E 15 


20 


/* 






*/SE15 


30 


/* SMOOTH AN EQUIOISTANTLY TABLED FUNCTION USING 


•/SE15 


40 


/* A FIRST DEGREE POLYNOMIAL FIT 


RELEVANT TO FIVE POINT*? 


•/SE15 


50 


/* 






•/SE15 


60 


/*♦*****«**» 


■'**«**'»«*«*««*««*««««*****«*««**«***«*«««««*««««*«*««««««»/ $£15 


70 


PROCEOUREIY,Z,OIM),. 




SE15 


80 


DECLARE 






SE15 


90 


l»l» 


,Z(*1,YA,Y6,YC,YD,YEI 




SE15 


100 


BINARY FLOAT, 


/♦SINGLE PRECISION VERSION 


/•S^/SEI5 


110 


/» BINARY FLOAT! 53), 


/'DOUBLE PRECISION VERSION 


/•D^/SE15 


120 


(DIM 


DBINARY FIXED, 




SE15 


130 


ERROR EXTERNAL CHARACTERUJ,. 




SE15 


140 


IF DIM G6 


5 


/•TEST SPECIFIED DIMENSION 


•/SE15 


150 


THEN DC. 






SE15 


160 


YA 


.Y(4),. 




SE15 


170 


YE 


=YI2I,. 




SE15 


180 


YO 


=Y(l),. 




SE15 


1<>0 


YC 


=YD*JYE-YA)/2,. 


/•MODIFICATION, SET YC TO 


((0) '/SEl? 


200 


Y9 


=YC-Y(5t*YA,. 


/♦MODIFICATION, SET YB TO 


r(-l)^/SE15 


210 




00 I -3 TO DIM,. 




SE15 


220 




YA =YB,. 


/•REPLACE YA BY YII-4) 


•/SEI5 


230 




YB =YC,. 


/•REPLACE YB BY YII-3) 


•/SE15 


240 




YC =Y0,. 


/•REPLACE YC BY YtI-21 


•/SE15 


250 




YO -YE,. 


/•REPLACE YD BY YII-II 


•/SEI5 


260 




YE =Y)I),. 


/•SET YE TO YII) 


•/SE15 


270 




Z(I-2)=(YA+YB+YC 




SE15 


280 




+YD+YE)/5,. 


/•SET Y(I-2I TO ARITHMETIC 


MEAN^/SE15 


290 




END,. 




SE15 


300 


YA 


=YC+YD*YE+YE,. 




SE15 


310 


ZIDIM-U,YA=(YA+YA+YD+YB1/IC, 


. 


SE15 


320 


ZIDIM).YA*YA-Z(DIH-2),. 




SEI5 


330 


ERROR='C',. 


/•SUCCESSFUL OPERATION 


•/SE15 


340 


END, 






SE15 


350 


ELSE ERRORS 'IS. 


/•ERROR IN SPECIFIED DIMENSION •/SEIS 


360 


END,. 




/•END OF PROCEDURE S15 


•/SE15 


370 



Purpose: 

SE15 computes a vector Z = (zj, Z2 ^DIm) °^ 

smoothed function values, given a vector Y= (y^, 
yo' • • • > yDIM^ °^ function values whose components 
Yl correspond to DIM equidistantly spaced argument 
values Xj with xj - X}_-^ = h for i = 2, . . . , DIM. 



Usage: 



CALL SE15 (Y, Z, DIM); 
Y(DIM) 



Z(DIM) 



DIM 



Remarks: 



BINARY FLOAT [(53)] 

Given vector of function values, 

BINARY FLOAT [(53)] 

Resultant vector of smoothed function 

values. 

BINARY FIXED 

Given dimension of vectors Y and Z. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error condition 
that may be detected: 

ERROR=« 1' means DIM is less than five. 
Vectors Z and Y may be identically allocated, which 
means that the given function values are replaced 
by the resultant smoothed function values. 

Method: 

The smoothed function values are obtained by 
evaluation of the least squares polynomial of degree 
one relevant to five successive points. 



F. B. Hildebrand, Introduction to Numerical Analysis , 
McGraw-Hill, New York- Toronto-London, 1956, 
pp. 295-302. 

Mathematical Background: 

For i = 5, . . . , n we find m. and b. such that 



w.(x) = m.x+b. 
1 1 i 



(1) 



gives the least-squares fit to the points (X{_jj,yj_jj), 
k=0, . . . , 4. The problem, then, is to minimize 



F(m.,b.)= Z^ rw.(x. ,) -y, , ] 



k=0 



This minimum will occur when 



9F „ ^ 9F 
1 1 



(2) 



Now 



"flTT = 22^ rw.(x. , )-y. , 1 



and 



8F 



= 2 



E 

k=0 



s. , rw.(x. , )-y. , 1 
i-k I 1^ i-k' ^ i-k J 



(3) 



Solving equations (2) and (3) yields: 
4 , / 4 



E Vkyi-k-ifZ Vk)(E ^i- 



k=0 



,k=0 



lk=0 



^ 2^/4 

L ""i-k ■ 5 2 h-k 



(4) 



k=0 



Vk=0 



and 



'^^"^S [^i-k-^^iV^] 



(5) 
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Using the fact that Xj -xj_j = h, a constant, for 
j = 2, . . . ,n, equations (4) and (5) may be rewritten 
as 



• Subroutine SE35 



"^i = m ^% ^ h-1 - h-3 -^hJ 



(6) 



and 



4 



^^■i" fn ^i-k""'iV2 (^> 

fc=0 



Using equation (7) in equation (1) yields 

w.(x)=m.(x-x._2)+|(y._^+...+y.) 

The desired smoothed fimction values zj are given 
by: 



^<^i> = T <^yi ^ 2y2 + yg - yg) 

i=l 
^^(^9) = TTT (4y, + 3y, + 2y, + y J 



5' 2 



10 ' •'1 



2 "•'3 •'4' 
i=2 



W. „(x.) =— (y. „ + V. . + V. + y. 
i+2^ i' 5 ^-^1-2 -^i-l -^i -^i+l 



1 



+ V ) 



i=3,...,n-2 
(8) 



w (x ,) = -TTT (y „+2y „+3y , 
n n-1 10 ^•'n-S •^n-2 "^n-l 



+ 4y ) 



i=n-l 



w (X ) 
n n' 



T<-V4-'V2-'2yn-l 



+ 3y^) 



■SE35.. 






SE35 


10 


/««««**«*««« 


!.***♦*♦*«#**»**»«*♦«,♦»*«#*#„»«**, «„»^»*,„*„^,,^,^„^^j,^5gjg 


20 


/* 






♦/SE35 


30 


/* SMOOTH AN EQUIDISTANTLY TABLED FUNCTION USING 


♦/SE35 


hG 


/* A THIRD DEGREE POLYNOMIAL FIT 


RELEVANT TO FIVE POINTS 


♦/SE35 


50 


/* 






*/SE35 


60 


/*#***»♦««♦*#*,*«**####***«(,»«,:,****# 


#»»*********9****.**********#**t:*M/S^^^ 


70 


PROCEDUREt Y.Z.OIH),. 




SE35 


80 


OECLAPE 






$E35 


90 


(Y(*),Z(*(,VA,YB,Yi;, 




SE35 


100 


OAfDBtOABtOBC) 




SE35 


110 


BINA 


Y FLOAT, 


/♦SINGLE PRECISION VERSION /*S*/SE35 


120 


/* BINARY FLOAT) 53), 


/*OOUBLE PRECISION VERSION /tOVSEBS 


130 


(DIM 


DBINARY FIXED, 




SE35 


1*0 


ERROR EXTERNAL CHARACTER) 1 ) , . 




SE35 


150 


If DIM GE 


5 




SE35 


160 


THEN DO,. 






SE35 


170 


YA 


=Y(4),. 




SE35 


ISO 


YB 


=Y(U,. 




SE35 


190 


YC 


=Y(21,. 




SE35 


200 


D8C 


=YB- YC*YA-YC+YA-Y( 5) , , 




SE35 


210 


OB 


=(0BC+D6C 




SE35 


220 




+YA+YB+YBI/3-YC,. 


/♦MODIFICATION DB =0ELTA2(ll 


♦/SE35 


230 


OBC 


=0BC/2,. 


/•MODIFICATION DBC=DELTA3( 1/21 */SE35 


240 




DO I =3 TO DIM,. 




SE35 


250 




VA =VB,. 


/♦REPLACE YA BV Y(I-2I 


♦/SE35 


260 




V6 =YC,. 


/♦REPLACE Y8 BY YU-1) 


♦/SE35 


270 




YC =YIIJt. 


/♦SET YC TO Yin 


♦/SE35 


280 




DA =0B,. 


/♦SAVE OLD SECOND DIFFERENCE 


*/SE35 


290 




DB ={YA-YB)-(YB-YCI,. 


/♦COMPUTE DELTA2(I-1J 


♦/SE35 


300 




DAB =DBC,. 


/♦SAVE OLD THIRD DIFFERENCE 


♦/SE35 


310 




OBC =DA-OB,. 


/♦COMPUTE OELTA3(I-3/2) 


•/Se35 


320 




ZtI-2)=YA 


/♦SET 2(1-2) TO 


♦/SE35 


330 




-(DA6-DBC>*6/70,. 


/♦YtI-21-DELTA*(I-2)+6/70 


♦/SE35 


340 




END,. 




SE35 


350 


DA 


=(0AB-OBC)/35,. 




SE35 


360 


Z(01M-1J=YB+0A+DA,. 


/♦COMPUTE LAST TMO SMOOTHED 


•/SE35 


370 


Z(DIM)=YC-DA/2,. 


/♦VALUES 


♦/se35 


380 


ERROR='C',. 


/♦SUCCESSFUL OPERATION 


♦/SE35 


390 


END, 






SE35 


400 


ELSE EPRQR='i',. 


/♦ERROR IN SPECIFIED DIMENSION 


♦/Se35 


410 


END,. 




/♦END OF PROCEDURE S35 


♦/Se35 


420 



i=n 



Purpose: 

SE35 computes a vector Z =(zj, Z2, . . . , Zdim) of 
smoothed function values, given a vector Y= (y^, 
y2> • • • ' yDIM) of function values whose compon- 
ents ji correspond to DIM equidistantly spaced ar- 
gument values xj wifli Xi-xj_i = h for i = 2, .... 
DIM. 

Usage: 

CALL SE35 (Y, Z, DIM); 

Y(DIM) - BINARY FLOAT [(53) ] 

Given vector of function values. 
Z(DIM) - BINARY FLOAT [(53)] 

Resultant vector of smootiied function 

values. 
DIM - BINARY FIXED 

Given dimension of vector Y and Z. 

Remarks: 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error condition 
that may be detected. 

ERROI^' 1' means DIM is less than five. 
Vectors Z and Y may be identically allocated, which 
means that the given function values are replaced by 
the resultant smoothed fxmction values. 
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Method: 

The smoothed function values zj are obtained by 
evaluating at x| the least squares polynomial of 
degree three relevant to five successive points. 

For reference see: 



Solving (2) and (3) for aj, bj, c., and d., with x. - 
Xi_i = h, we get: 



b. = -3 A. X. „ + B. 
1 1 i-2 i 



F. B. Hildebrand, Introduction to Numerical 7\naly- 
sis , McGraw-Hill, New Yoife- Toronto- London, 1956, 
pp. 295-302. 

Mathematical Background: 

For i = 5, . . . , n we must find aj, bj, Cj, and dj such 
that 



3 2 

w. (x) = a.x + b,x + c.x + d. 
11 i 1 1 



(1) 



c. = 3A.X. „ -2B.X. „ + C. 
1 11-2 1 1-2 1 



3 2 

d. = -A.X. „ + B.x. - -C.x. „ + D. + y, 
1 11-2 1 1-2 1 1-2 1 •'i 



where: 



'.-is ',-: 



k=0 



gives the least-squares fit to the points (xj_jj, 
yi_k), k= 0,...,4. 

The problem, thus, is to minimize 



F(ai. bi, c., d.) = E [wi(xi_k) - yi_k] 



The minimum will occur when 



9F 9F 9F _ 9F 

9a. ~ 9b. " 9c. ~ 9d. " 
1111 



(2) 



Now: 



12h 



^r^^%-4^^i-3^h.i^%-^%^ 



S=iir(yi-4-'yi-3-'^yi-i-yi> 



Finally, the desired smoothed values z. are given 

I, 1 

by: 



4 3 



* 2 
- = 2Ex^_,fw^(._,)-y^_,] 



_9F 
9b 



9F 

9c. .■^- i-k V i-k' -^i-k 
1 k=0 L J 



9F 



u = 2 E K-^_t) - y^ 



9d 



i k=0 



rw.(x. , ) - y. , 1 
[ V i-k' •'i-k J 



(3) 



r^(^> =yi-^«% 



^<V =^2^-^^% 



if i=l 



if i=2 



z. = < 1+2 
1 ^ 



3 ,4 



<^i^ =^1-35*^1 tfl=3....,n-2l^(4) 



2 4 

■w(xj =y,+Tr5yo ^ i=n-i 

n n-1 -^n-l 35 •'n-2 



1 4 
w(x) =y-7rr6y„ if i=n 

. n^ n •'n 70 ■'n-2 y 



where: 
.4 



5 y. = y. o~4y. , + 6v. - 4v. , + V. „ 
•'i •'1-2 ■'i-l •'i •'i+l ■'i+2 

for i=3,.. . ,n-2 
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• Subroutine EXSM 



EXSM.. 










Exsn 10 


/*******************L*************,t9****«*******m*************«******9/iX^ 20 I 












•/EXSM 30 


/* TO FIND THE TRIPLE EXPONENTIAL SMOOTHEO SERIES 


S 


OF A GIVEN 


«/EXSH 40 


/* SERIES X. 










*/EXSH 50 












*/EXSN 60 


/*****m**************»******^*****»»tt*tL9***»*m***^******0**i-*i.t: 


••♦♦•♦♦/EXSH 70 I 


PROCEDURE tX.NX,AL»A,B,C.SI,. 










EXSM 80 


DECLARE 










EXSM 90 


fXt*),S(«),ALtA.e»C,BE.ALCUB,eECUBtOIF) 










EXSH 100 


BINARY FLOAT, 










EXSM 110 


ERROR EXTERNAL CHARACTERlll. 










EXSM 120 


(I, NX) 










EXSM 130 


BINARY FIXEOt. 










EXSM 140 


/* 










*/EXSIi 150 


ERROR='0',. 










EXSH 160 


/« 










*/EXSM 170 


/* TEST THE VALUE OF ALPHA 










*/EXSM 180 


/* 










•/EXSM 190 


IF AL LE OR AL GE I 










EXSH 200 


THEN DO.. 










EXSH 210 


ERROR-' I'.. 










EXSM 220 


GO TO FIN,. 










EXSM 230 


END,. 










EXSM 240 


IF NX LT 3 










EXSM 250 


THEN DO,. 










EXSN 260 


ERR0R=*2',. 










EXSM 270 


GO TO FIN,. 










EXSH 280 


END,. 










EXSM 290 


/♦ IF A=:B=C=0.0, GENERATE INITIAL VALUES OF A 


B, 


AND C 




♦/EXSH 300 


/* 










*/EXSH 310 


IF A = CO AND e = 0.0 AND C = 0.0 










EXSM 320 


THEN DO,. 










EXSH 330 


C =XC1)-2.0*X(2)*X(3I,. 










EXSH 340 


e =XI2l-X(l)-l.5*C,. 










EXSH 350 


A =X<1)-B-0.5*C,. 










EXSH 360 


END,. 










EXSM 370 


BE =1.0-AL,. 










EXSH 380 


BECUB=SE**3,. 










EXSM 390 


ALCUB=AL»*3,. 










EXSH 400 


/• 










•/EXSM 410 


/* DO THE FOLLOWING FOR I = 1 TO NX 










•/EXSM 420 


/• 










•/EXSM 430 


DO I = I TO NX,. 










EXSM 440 


SU) =AtB*C.5*C.. /* FIND SU) 


FOR 


1 


PERIOD 


AHEAO*/EXSM 450 | 


/* 










*/EXSH 460 


/* UPDATE COEFFICIENTS A, B, AND C 










•/EXSH 470 


/* 










•/EXSM 480 


DIF -Stl)-XU),. 










EXSH 490 


A =X(I>*6ECUB*DIF,, 










EXSH 500 


B =6*C-1.5«AL*AL*(2.0-ALJ*OIF,, 










EXSH 510 


C =C-ALCUB»DIF,. 










EXSM 520 


END,. 

FIN . , 










EXSH 530 


RETURN,. 

END,. /«ENO OF PRO< 










EXSH 540 
EXSH 550 


EDURE 


EXSM 




•/EXSM 560 



Purpose: 

EXSM develops the triple exponential smoothed 
series S of the given series X. 

Usage: 

CALL EXSM (X, NX, AL, A, B, C, S) ; 

Description of parameters: 
X(NX) - BINARY FLOAT 

Given vector containing time series data 

to be exponentially smoothed. 
NX - BINARY FIXED 

Given number of elements in X. 
AL - BINARY FLOAT 

Given smoothing constant alpha. AL must 

be greater than zero and less than one. 
A, B, C- BINARY FLOAT 

Given coefficients of the prediction equation 

where S is predicted T periods hence by 

A + B • T + C • T^/ 

As input: If A=R=C^O, the program will 

provide initial values. If at least 



S(NX) 



one of A, B, and C is not zero, 
the program will take given 
values as initial values. 

As output: A, B, C, contain latest updated 
coefficients of prediction. 

BINARY FLOAT 

Resultant vector containing triple expo- 
nential smoothed time series. 



Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error conditions 
that may be detected: 

ERR0R=1 - The specified smoothing constant, AL, 
is less than or equal to zero or is 
greater than or equal to one. 

ERROR=2 - The nimiber of data points is less than 
three. 

Method: 

Refer to R. G. Brown, Smoothing, Forecasting and 
Prediction of Discrete Time Series. Prentice- Hall, 
1963, pp. 140 to 144. 

Mathematical Background: 



This procedure calculates a smoothed series S-^, Sg, 

.... Sjqx, given time series Xj^, Xg Xj^x 

and a smoothing constant a . Also, at the end of the 
computation, the coefficients A, B, and C are given 
for the expression A + B(T) + C(T)2/ . This ex- 
pression can be used to find estimates of the smooth- 
ed series a given number of time periods, T, ahead. 

The procedure has the following two stages for 
i = 1, 2, . . . , NX, starting with A, B, and C either 
given by the user or provided automatically by the 
procedure (see below): 

1. Finds Sj for one period ahead 



S. = A+ B+ 50 
1 



2. Update coefficients A, B, and C 



A=X + (l-a) (S. -X.) 
i ^1 i' 



B = B + C - 1. 5 (a ) (2 - a) (Sj - Xj) 



C=C-(0!^)(S.-Xj) 



(1) 

(2) 
(3) 
(4) 
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where a= smoothing constant specified by the 
user 

(0.0 < a <1.0) 

H coefficients A, B, and C are not all zero (0. 0), 
take given values as initial values. However, if 
A=B=O0. 0, generate initial values of A, B, and C 
as follows: 



Roots and Extrema of Functions 



• Subroutine FMFP 



C= X. 



1-2X2 



+ Xc 



B=X2-Xi-1.5C 



A=Xj - B- 0.5C 



(5) 
(6) 
(7) 



*«*i«**«*««ik*«««»*«*: 



********************* ********»***•' 



/* FIND A LOCAL MINIMUM Of A FUNCTION OF SEVERAL VARIABLES 

/* BY THE HETHOO OF FLETCHER AND POWELL 

/* 

/******************************************************************** 
PROCEDURE 1FUNCr.NtX,F.C.EST,EPS>LIMIT),. 
DECLARE 

II.J«KOUNT,K.L>LIMIT.N.NS.N2.N3) 

BINARY FIXED, 

(X(*)*G(«')tH(N*IN+7)/2) ,ALFAtAHBDA.OALFAtOX,OY,GStGr4RM,FS. 

EPS,EST,F,FX»FY,H1.H2,HNRM,OLOF.T,H,2> 

/*SIN6LE PRECISION VERSION 
/♦DOUBLE PRECISION VERSION 



/♦COMPUTE FUNCTION VALUE 
/•AND GRADIENT VECTOR 



5C 





6INA0Y FLOAT, 


/* 


BINARY FL0AT(53), 




FUNCT 




ENTRY, 




ERROR EXTERNAL 




CHARACTER(l) ,. 


NS 


=N,. 


N2 


=NS*NS,. 


N3 


-N2+NS,. 


CALL 


FUNCT(X,FS,G),. 


ERROR-»0',. 


KOUNT<0, . 


CONT.. 




1 


"N3,. 




DO J = NS-1 TO C BY -I,. 




K =1+1,. 




H(Kt =1,. 




I "K*J,. 




DO L =. K+l TO I,. 




HU) =0,. 




END.. 




END.. 


LOOP.. 




K0UNT=K0UNT+1,. 


OLOF 


«FS,. 


OY.HNRM.GNRM=C,. 




00 J = 1 TO NS,. 




HINS+Jl.GS-GIJI.. 




H(N2+J)=XtJ),. 




T »0,. 




K =N3+J,. 




00 L = I TO NS,. 




T =>T-GIL)*^(K).. 




IF L LT J 




THEN K =K+NS-L,. 




ELSE K -K+l,. 




END.. 




H(J» »T,. 




HNRM "HNRM+ABSUl,. 




GNRM =GNRH+ABS(GSI». 




DY =OY+T*GS,. 




END,. 


IF DV LT 


THEN 


IF HNRM/GNRH GT EPS 


THEN 


GO TO LABI.. 


GO TO REST,. 


LABI.. 




FY 


=FS,. 


AMBOA=M 1 N ( 1 , 2* ( e ST-F S ) /D Y ) , . 


IF AMBOA LE 


THEN 


AHaDA=l,. 


ALFA 


=0, . 


SAVE.. 




FX 


=FY,. 


OX 


=DY,. 




DO I = 1 TO NS,. 




Xtl) =XtI»AMSOA*H(l),. 




END,. 


CALL 


FUNCT(X.FS,G).. 


FY 


=FS,. 


DY 


=0.. 




DO ! = 1 TO NS,. 




OY =DY+6(l)*H(n.. 




END,. 


IF FY LT FX 


THEN 


DO,. 




IF DY= 




THEN GO TO COMP,. 




IF DY LT C 




THEN DO,. 




ALFA,AMBDA=AMBOA>ALFA 




IF HNRM*AMBDA LE lElC 




THEN GO TO SAVE.. 




ERROR= ' 2 ' , . 




GO TO RETURN.. 




END.. 



/•GENERATE IDENTITY MATRIX 



/•START ITERATION LOOP 

/•SAVE FUNCTION VALUE, 
/•ARGUMENT VECTOR 
/•AND GRADIENT VECTOR 



/•DETERMINE DIRECTION VECTOR 



/♦CALCULATE DIRECTIONAL 
/♦DERIVATIVE *N0 TESTVALUES 
/♦FOR DIPECTION VECTOR H 
/♦AND GRADIENT VECTOR G. 
/♦REPEAT SEARCH IN DIRECTION 
/♦OF STEEPEST DESCENT IF 
/•DIRECTIONAL DERIVATIVE 
/♦APPEARS NOT NEGATIVE 
/♦SEARCH MINIMUM ALONG H 



/♦SAVE FUNCTION AND DERIVATIVE 
/♦VALUES FOR OLD ARGUMENT 



/♦STEP ARGUMENT ALONG H 



/•COMPUTE DIRECTIONAL OERIVA- 
/♦TIVE OY FOR NEW ARGUMENT. 
/•TERMINATE SEARCH. IF OY GE 
/♦IF OY*0,THE MINIMUM IS FOUND 
/♦PROVIDED FUNCTION DECREASED 



/♦TERMINATE SEARCH IF 

/•MINIMUM PASSED 

/♦DOUBLE STEPSIZE AND REPEAT 



/♦ARGUMENT OUT OF RANGE 



END,. 
T =0,. 
LAS2.. 

IF AMBDA= 

THEN GO TO COMP,. 

Z =3^(FX-FY)/AMBDA*0X+DY,. 

ALFA =MAX(ABS{Z),A6S(DX).ABS(DY)),. 

OALFA=Z/ALFA,. 

DALFA»OALFA^DALFA-OX/ALFA^DY/ALFfl, . 

IF OALFA LT C 

THEN GO TO REST,. 

W =ALFA^S0RTIDALFA1 ,. 

ALFA =DY-OX+W*W,. 

IF ALFA^O 

THEN ALFA =IZ*DV-10/( Z*DX*Z*DVI , . 

ELSE ALFA =C DY-Z+M>/ALFA, . 

ALFA =ALFA^AMBOA,. 

OALFA=T-ALFA,. 

DO I = 1 TO NS,. 

Xd) =X(I)+OACFA*H(II,. 

END.. 
CALL FUNCT(X,FS,GJ,. 
IF FS LE FX 
THEN IF FS LE FY 

THEN GO TO CCMP, . /♦TERMINATE INTERPOLATION 

OALFA=C,. 

DO I = I TO NS,. 

OALFA=DALFAtG(l)^H(I|,. 

END,. 
IF DALFA LT 
THEN IF FS LE FX 



/♦INTERPOLATE IN NEM INTERVAL 
/♦COMPUTE ARGUMENT X 



FMFP 
♦/FMFP 
•/FMFP 
•/FMFP 
♦/FMFP 
♦/FMFP 
/FMFP 
FMFP 
FMFP 

FWFP IOC 

FMFP 110 

FMFP 120 

FMFP 13C 

S^/FMFt> 140 

O^/FMFO 150 

FMFP 160 

FMFP 170 

FMFP 16 

FMFP 190 

FMFP 200 

FMFP 21C 

FMFP 220 

♦/FMFP 230 

•/FMFP 240 

FMFP 25C 

FMFP 260 

FHFP 270 

•/FMFP 

FMFP 290 

FMFP 300 

FMFP 310 

FMFP 320 

FMFP 330 

FHFP 3*0 

FHFP 350 

♦/FMFP 360 

FMFP 37C 

♦/FMFP 380 

♦/FMFP 390 

•/FMFP 400 

FMFP 410 

FHFP 420 

FMFP 430 

FMFP 440 

♦/FMFP 450 

FMFP 460 

FMFP 470 

FMFP 480 

FMFP 490 

FMFP 500 

FMFP 510 

♦/FMFP 52C 

♦/FMFP 530 

♦/FMFP 540 

♦/FMFP 550 

•/FMFP 560 

•/FMFP 570 

♦/FHFP 580 

♦/FHFP 590 

•/FMFP 600 

FMFP 610 

FHFP 620 

FHFP 630 

FMFP 640 

FMFP 650 

♦/FMFP 660 

♦/FHFP 670 

FHFP 680 

♦/FMFP 690 

FMFP TOO 

FMFP 71C 

FMFP 720 

FMFP 730 

♦/FMFP 740 

♦/FMFP 750 

•/FMFP 760 

♦/FMFP 770 

♦/FMFP 780 

FMFP 790 

FMFP 800 

FMFP 810 

♦/FMFP 820 

♦/FMFP 830 

♦/FMFP 840 

FMFP 850 

FMFP 860 

♦/FHFP 870 

FMFP 880 

FHFP 890 

FMFP 900 

FMFP 910 

FMFP 920 

♦/FMFP 930 

♦/FMFP 940 

FMFP 950 

FMFP 960 

FHFP 970 

FHFP 980 

FHFP 990 

FMFPIOOO 

FMFPIOIO 

FMFP1020 

FMFP1030 

FMFP1040 

FNFP1050 

FMFP1060 

FMFP1070 

FMFPlOeO 

FMFP I 090 

FMFPllOO 

FMFPIllO 

FMFP 1120 

FHFP1130 

•/FHFP1140 

FMFP1150 

FMFP 1160 

FMFP1170 

FMFP1180 

FMFP1190 

FMFP 1200 
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THEN DO,. 




FMFP1210 


FX =FS,. 




FMFP1220 


OX =DALFA,. 




FNFP1230 


T,AMBOA=ALFA,. 




FMFP 1240 


GO TO LAB2,. 


/♦REPEAT INTERPOLATION 


♦/FMFP 1250 


END*. 




FMFP I 260 


FY sFS,. 




FMFP 1270 


DY -OALFA,. 




FMFP 1280 


AHBD&'AMBOA-ALFA«. 




FMFP1290 


T =0,. 




FMFP1300 


GO TO LAB 2,. 


/♦REPEAT INTERPOLATION 


♦/FMFP1310 


COMP.. 




FMFP 1320 


on J = 1 TO NS,. 


/♦COMPUTE DIFFERENCE VECTORS 


♦/FMFP1330 


K =NS*J,. 


/♦OF ARGUMENT AND GRADIENT 


♦/FMFP 1340 


M(Kl =G(J)-H«KI,. 




FMFP 1350 


K =NSi-Kt. 




FMFP1360 


H(K1 =XU)-H(K),. 




FMFP1370 


END.. 




FMFP1380 


IF OLDF+EPS LT FS 




FMFP1390 


THEN GO TO REST,. 


/♦TERMINATE ITERATION 


♦/FMFP 1400 


'ERROR='0',. 




FMFP I 410 


IF KQUNT GE NS 




FHFP1420 


THEN DO,. 




FMFP1430 


Til -0,. 




FMFP 1440 


DO J =■ 1 TO NS». 




FHFP1450 


W =H(N2+Jlt. 




FMFP1460 


T =T+ABS(M>,. 




FMFP I 470 


Z =Z+HINS+J)*W,, 




FMFP1480 


END,. 




FMFP 1490 


IF HNRM LE EPS 




FMFP 1 500 


THEN IF T LE EPS 


/♦TERMINATE, IF ARGUMENT DIFF. 


♦/FMFP1510 


THEN GO TO RETURN,. 


/♦VECTOR AND DIRECTION VECTOR 


♦/FHFP1520 


ENO,. 


/♦ARE BOTH LE EPS 


♦/FMFPI530 


IF KOUNT GE LIMIT 




FMFP 1540 


THEN GO TO NCON,. 




FMFP 1550 


ALFA =C,. 




FMFP 1560 


DC J = 1 TO NS,. 




FMFP1570 


W =0,. 




FMFP1580 


K =N3+J,. 




FMFP 1590 


DO L = 1 TO NS,. 




FMFP 1600 


M =M+H(NS*L)*HIK),. 




FMFP1610 


lf= L LT J 




FMFP1620 


THEN K =K*NS-L,. 




FMFP1630 


ELSE K =K*1,. 




FMFP1640 


END,. 




FMFP1650 


ALFA =ALFA+W*H(NStJI,. 




FMFP1660 


HU) =W,. 




FMFP1670 


END,. 




FMFP 1680 


IF Z*ALFA» 




FMFP 1690 


THEN GO TO CCNT,. 




FMFP1700 


K ^NS+l,. 




FMFP1710 


DO L = I TO NS,. 


/♦UPDATE MATRIX H 


♦/FHFP1720 


HI =H(N2*L)/Z,. 




FMFP1730 


H2 =HtL)/ALFi,. 




FMFP 1740 


DO J = L TO NS,. 




FMFP 1750 


HIK) =H{K)+Hl*H(N2tJ) 




FMFP1760 


-H2*H(J),. 




FMFP 1770 


K =K*1,. 




FMFP1780 


END,, 




FMFP 1790 


END,. 




FMFP 1800 


GO TO LOOP.. 


/♦END OF ITERATION LOOP 


♦/FMFP1810 


NCON.. 




FMFP1820 


ERROR=*l'.. 


/♦NO CONVERGENCE 


♦/FMFP 1830 


GO TO PETUPN,. 




FHFP1840 


REST.. 


/♦RESTORE OLD VAL, ARG 


♦/FHFP1850 


DO J = 1 TO NS,. 




FMFPiaeO 


X(J» =H(N2*J),. 




FMFP1870 


END,. 




FMFP 1 880 


CALL FUNCT(X,FS,G),. 




FMFP 1890 


IF GNRM GT EPS 




FHFP1900 


THEN IF fRROF= '3' 




FMFP1910 


THEN GU TO RETUPN,. 




FMFP 1920 


ELSE 00,. 




FMFP193C 


eRR0R='3' ,. 


/♦REPEAT, IF DERIVATIVE GT EPS ♦/FMFP1940 | 


GO TO CCNT., 




FMFP1950 


END,. 




FMFP 1960 


ERR0R=*C',. 




FMFP 1970 


FETURN., 




FMFP1980 


F =FS,. 




FMFP 1990 


END,, 


/♦END OF PROCEDURE FMFP 


♦/FMFP2000 



Purpose: 

FMFP determines an unconstrained minimum of a 
function of several variables, given a starting value 
of argument vector. 

Usage: 

CALL FMFP (FUNCT, N, X, F, G, EST, EPS, 
LIMIT); 

FUNCT - ENTRY 

Given procedure computing function 
values and gradient vectors. This pro- 
cedure must be supplied by the user. 

Usage: 

CALL FUNCT (X, FS, G); 

X(N) - BINARY FLOAT [(53)] 



Given n-dimensional argument 

vector. 
FS - BINARY FLOAT [(53)] 

Resultant function value. 
G(N) - BINARY FLOAT [(53)] 

Resultant gradient vector. 

N - BINARY FIXED 

Given number of variables (= dimension 

of argument vector). 
X(N) - BINARY FLOAT [(53)] 

Given starting value of argument vector. 

Resultant argument vector corresponding 

to the minimum. 
F - BINARY FLOAT [ (53)] 

Resultant minimum function value, 
G(N) - BINARY FLOAT [ (53)] 

Resultant gradient vector corresponding 

to tiie minimum. 
EST - BINARY FLOAT [(53)] 

Given estimate of minimum function 

value. 
EPS - BINARY FLOAT [ (53)] 

Given test value representing the ex- 
pected absolute error. 

LIMIT - BINARY FIXED 

Given maximum number of iterations 
to be performed. 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 



ERROR='l' 
ERROI^'2' 
ERROR='3' 
Method: 



means no convergence in LIMIT 

iterations. 

means no minimum is located by 

linear search technique. 

means error in gradient calculation. 



FMFP uses a method of conjugate directions, pro- 
posed by Davidon. For a quadratic function of n 
variables the minimum is located within n itera- 
tions. 

For reference see 

R. Fletcher and M. J. Powell, "A Rapidly Con- 
vergent Descent Method for Minimization", Com- 
puter Journal, vol. 6, iss. 2, 1963, pp. 163-168. 
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Mathematical Background- 



Therefore: 



It is assumed that the function f of the n variables 
Xj , . . . , Xjj (abbreviated as argument vector x) may 
be computed together with its gradient vector g(x) 
for any point x. The generalized Taylor expansion 
for functions of several variables is 



1 T 
f(»m) = f(x) + g(x) • u + -r- u G(x)u + higher terms 

where g is the gradient vector and G the matrix of 
second order partial derivatives. Vectors are as- 
sumed to be column vectors; uT means transpose of 
vector u. It is assumed that in the neighborhood of 
the required minimum Xjj^j^ the function is approxi- 
mated closely by the first three terms of its Taylor 
expansion, giving 



f(x) = f(Xn,iii) + Y (X - x^in) G{x^i^)(x-x^i^) 

since g(x^jjj) = 0. Then the gradient is seen to be 
approximately g(x) = G{Kj^i^) (x - Xj^in). 

Assume now that the symmetric matrix G is 
positive definite. Then the following equation holds 
true: 



scalar product 



,W i,(3\- 



n-1 



i=j+l 



t. (Gh 



(i) 



h«^ 



Suppose now that the vectors h , h^ , ... , 
h(n-l) are G-conjugate, satisfying (Gh(i), h"o = 
for i ^ j. Then (gW, h 0)) = 0, and since h(0), 
h(l), .... h(°-l) form a basis, g(n) = o and x<n) = 
Xjjjjjj. This shows that the minimum is located at 
the n*" iteration for a quadratic function when using 
successive linear searches for G-conjugate direc- 
tions. 

Programming Considerations: 

For the generation of G-conjugate directions, start 
with h(") = -g( ' and calculate successive directions 
h(i) by means of h(i) = _G(i)g(i), where G^^) is modi- 
fied to G^^j*"^) so that h^^) is an eigenvector of the 
matrix G^'*^) G with eigenvalue 1. This ensures 
that g(^) approaches G"^ as x^*) approaches x^^^. 
An easy calculation shows: 



which would allow x^^^ to be calculated in one step 
if G"-'- (Xjjjjjj) were available. 

To approach G~ (Xjj^jjj) , a method of successive 
linear searches in G-conjugate directions is used. 
Starting with the identity matrix G^^) = I, a sequence 
of symmetric matrices G(i) is generated that ap- 
proximates G~^. At the (l+l)St iteration step a 
linear search is made in direction h(i) = -G(i)g(i), 
where g(^) is an abbreviation for g(x(^)). By means 
of the linear search the minimum of y(t) = f(x(^)) + 
t • h(i)) is determined, giving argument x^^'''^) = 
xW + \ • h(i). 

The argument of the minimum x^^"''^) on the line 
through xW in direction h(*) is determined by the re- 
lation that scalar product (g^^"*"^), h^^)) = 0. 



Now: 



n-1 



x<")=x«)+i: th<*> 

i=j 



and: 



n-1 



i=j 



Q(i+1) = Q(i) + dx. dx'^ _ G^'^dg . dg^G^^^ 
dx • dg dg^ G^^^dg 

(i) 



with dg = g^ ' 



dx= X - X' 



where all vectors are regarded as column vectors, 
and superscript T means transpose of column 
vector — that is, row vector. 

The strategy adopted for termination of the suc- 
cessive linear searches is as follows: 

1. If the fimction value has not decreased in the 
last iteration step, the search for the minimum is 
terminated provided the gradient is already suffi- 
ciently small; otherwise, the next step is in the 
direction of steepest descent. 

2. If the argument vector and the direction vec- 
tor change by very small amounts, and at least n 
iterations are performed, the minimization is ter- 
minated again. 

3. If the number of iterations exceeds an upper 
bound furnished by the user, further calculation is 
bypassed, and an error code is set to 1 indicating 
poor convergence. 

4. If one of the successive linear searches indi- 
cates that no constrained minimum exists, further 
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calculation is bypassed again and the error code is 
set to 2, indicating that it is likely that no minimum 
exists. 

The i term G is reset to the identity matrix 
if there is indication that the current G^^^is not 
positive definite, or if the formula for G^^'^-'-) breaks 
down because of zero divisors. 

The linear search technique used in procedure 
FMFP is as follows: 

For a given argument vector x and a vector h de- 
fining a direction through x, a local minimum of 
the function y(t) = f(xft • h) must be found. This 
means that a value tj^^ must be determined for 
which 



y' (t ) = scalar product (g(xft 



m 



h), h) =0 



From y' (0) = (g(x),h) < it is evident that a mini- 
mum y(t ) < y(0) should be found for positive 

values of t. 

The calculation of the minimum Is in three 

stages: 

1. Estimating the magnitude of tj^. 

2. Determining an interval containing tj^^. 

3. Interpolating the value of t^. 

An estimate of the stepsize may be obtained, as- 
suming that the true value of the constrained mini- 
mum is equal to the estimated value EST of the un- 
constrained minimum and that y(t) is closely repre- 
sented by a quadratic polynomial passing through x, 
y(0) with derivative y' (0): 

step = 2 (EST - y(0))/y' (0) 

This equation tends to overestimate the stepsize 
since the unconstrained minimum will normally not 
lie on the line through x with direction h. There- 
fore step is taken as stepsize s only if it is posi- 
tive and less than one. Otherwise s = 1 is taken as 
stepsize. 

At the second stage y(t) and y'(t) are examined at 

the points 



or if s„ 



> 10 



,10 



The last case (search argument rxms out of range) 
is interpreted as an indication that no local minimum 
exists on the given line. Therefore, the error in- 
dicator is set to ' 2' and further calculation is by- 
passed; that is, FMFP returns the current minimal 
value with ERROR = '2'. 

In case y' (S2) = O.tj^ is set to S2 and x^^^ = x+S2 
• h is used as argument of a constrained minimum 
on the line through x with direction h. 

In the second and third case y'(S2) > and/or 
y(s2) S:y(si), a minimum lies necessarily between 
Sj^ and S2. Its argument value gets approximated 
using cubic interpolation. 

The extrema of the cubic interpolation passing 
through (si, yi = y(si), y'l = y' (s^)) and S2, y2 = 
y (S2), y'2 = y' (^2)) 3-1^6 tb® roots of the quadratic 
equation 



;-2(^^y;)i^^-(y'i^y'2-^2z)^^ 



= 



with z = y'j^ + y'2-3 



^2~^1 



t-s. 



The substitution ■ 



^2-^1 



= \-a gives 



2, . 



y'2 - 2o(y 2+z)+a (y'^+yg+Sz) = 



with the solutions 

V ' + z ± w 
^ 2 



"^yi+y'2+2z 



where 



t= s, 2s, 4s s^, Sg 

where successive values are obtained by doubling 
the stepsize. 

This search is terminated at t = Sg if: 

y'(s2) = o 

or y' (Sg) > 
or y(S2) s y(Sj) 



w 



+ Y^ 



-yj^y 2 



It is interesting to note that y j < 0, y g ^ 0, 
as well as y'l < 0, y'2 <0, y2 ^yi. that is, |z|< 
ly'l + y 2 1> guarantee a real value of w. This means 
the cubic interpolation polsmomial has real extrema. 

The cubic interpolation polynomial may degenerate 
to a quadratic if y j + y 2+2z = 
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with minimum at 
I 



a = 



y 2-y 1 



The sign of w must be so chosen that a belongs to the 
minimum, which is necessarily between sj^ and Sg. 



From 



a = ■ 



y^ -z + w 



y ', + 2w 



(y^-z+wXy 2-y'j-2w) 
(y2-yi+2w)(y^-y'^-2w) 

(y2+z-w)(y'^+y 2-2z) 
(yi+y^+2z)(y'^+y'2-2z) " y'^+y2+2z 



y „+z-w 
^ 2 



It is easily seen that 



a = 



y 2 - 2+w 

y' -y'^+2w 



respectively, if y g-y j+2w = 



a = 



y „+z-w 
•^ 2 

y i+y 2+2z 



Hence 



< 



-y o -z 

•^ 2 
-yo-2z-y: 



<a = 



y 1+z-w 
J_2 

y'l+yg-^sz 



-y'2-^^ 

-y'2-2-y'i 



(2) 



Note that for the other root 



y „+z+w 
^ 2 



-7 2-2 



y'^+y^+2z -y2-2z-y'j 



< a 



The minimum of the cubic interpolation poly- 
nomial is located at 



Sg = S^+(l-0^ (Sg-S^) = 



^2-°'<'2' 



-1^ 



K y(s3) < Y{si) and y(s3) ^y(S2), then t^ is set 
equal to S3 and Xj^ = x+tj^^ • h is used as argument 
of the wanted minimum along the given line. Other- 
wise, the interval (sj, S2) is reduced by replacing 
sj by S3 if y(s3) < y(si) and y ' (S3) < and by re- 
placing S2 by S3 in all other cases. Then the inter- 
polation process is repeated for this new reduced 
interval. 



give the argument of the minimum in all cases. The 
first formula gives extra numerical stability if y ', 
is close to -y'2 and y^^ is close toyg and also contains 
the degenerate case as special. The second formula 
may be necessary if both extreme values lie be- 
tween s^ and Sg. Then the one closer to Sj is the 
minimum. (This follows easily from geometrical 
considerations. ) 



The following analysis shows that < a < 1: 
y 2 -^ ^» yi ^ ^ implies w > | z | . Hence 
I 

yo 



< 



y !+2w-y ' 



< a = 



y 2 + w-z 

y'2-yi+2w 



y 2+2w 
y^+2w-y^ 



< 1 



(1) 



yg ^y'i'y'2< implies 0>z ^y g+y', andw<|z| 
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PROCcJURE FMfP 06TERMINES AN UNC CNSTRflT NED MINIMUM OF A FUNCTIO"J TF 3FVFRAL VAPIABLFS 



♦♦#*Al********* 
* * 

*PKUCEOURe FMFP • 



» VALUE AND « 

* GRADIENT FOR * 

♦ GIVtN ARGUMENT * 



^t^t*Cl********** 


* PRESET 




» tRKDR=»0*t 
*lNiT. ITtRAT 




UN* 


• COUNT 




« 




»«*«««*««»««««•** 


»«** 






* ♦ 






» Ul *.x 






* * 






»#*« 






CUNT X 




«««*«D]^*«««««**** 


• 


* 


» GtNERATE 


* 


♦IDENTITY MATRIX* 


* IN 


H 


* 



»***»«#•*«**««*** 



• El «.X 



**** 
LOOP X 

• STEP IIERAIION * 

• COUNT, SAVE • 

• ARliOMENT AND * 

• 6KA0IENT • 



« COHP. SEARCH * 
» DIRECTION AND » 

• UIRECTIONAL * 

• DERIVATIVE OV * 

• * 



X 

.*. 
Gl ♦. 

« IS 
NO .•UiRECTIONAL*. 
...».DEK!yATIVE OV. 
• .NcGAIIVE .» 



HI *. 
.* IS *. 
rES .• MATRIX H 
X..». ILL CON 01- 
». HONED . 
* . -* 

* . .* 
• NO 



• j£T UP INITIAL • 

• ilEPSIZE FOR ». 

« LINEAR SEARCH • 
« « 



REST 

**«*«K l»*****«»*<< 

* RESTORE OLD • 

• VALUES OF • 
..X« ARGUHENT *. 

• (CURRENT * 

♦ MINIMAL VALUE) * 



SAVE 

««***A 2 *«**♦***** 
•SAVE OLD VALUES* 
•OF FUNCTION AND* 

..X* DIRECTIONAL » 

* DERIVATIVE • 

* ♦ 



««***B2 »«*•*♦♦*»• 

* STFP AROUMFNT * 
*ALONG DIRECTION* 

* CF LINEAR * 

* SEARCH » 

* * 
*****«****«*•*«** 



* VALUE AND • 

* GRADIENT FOR • 

* NEK ARGUMENT * 



***«*D2 ♦•****•*•* 
» CALCULATE * 

* CORRFSP. « 

* DIRECTIONAL ». 

* DERIVATIVE DY • 

* * 
***************** 



.*. 
A3 *. 
* HAS *. 
FUNCT ION *. VES 


LAB2 

*****A4*******«** 

* * 

• INIFRPOHTF « 


. *. 
A5 *. 
. * HAS 
. • C UB ! C A 

X*. REAL 

*. MINIMUM 


INCREASED.* 


X • MINIMUM * 



IS DV *. 

GREATER 
.THAN ZERO.* 



D3 



*, 



IS 

.*niRFCTIONAL*. 

.DERIVATIVE DY. 

*. EQUAL .* 

*.ZERO .* 

*. .* 
• NO 



*****E3* **♦*♦*»** 

* * 
*DOUBLE PREVIOUS* 

* STEPSIZE FOR * 

* LINEAR SEARCH * 

* * 
***************** 



F3 *. 
.« IS *. 

NO .* ABSOtUTf ». 
...•.STEPSIZE TOO .* 
*. BIG .* 



*****G2 ********** 

* * 

* MARK PREVIOUS * 

* FAILURE llITH *. 

* PRR0R='3' * 

* * 
**** 4*44 •••****•* 



NO 



H2 *. 

. * DID *. 
FAILURE 4 
OCCUR RE- 
. PEATEOLY . 4 



**** 

• • 

• Dl • 

• « 
**•* 



4i*»4r*G3********** 

* * 

*SET ERRORS- 2', * 

* LINEAR SEARCH » 

* OVERSHOOTS • 

* * 
*4«****«*4i«*****« 



*4.4« 4*4 44444c 44*4 4 



*4***P 44**44***44 

* * 
4RFPLACE ONE OF * 
4 THE PREVIOUS * 

* NODES * 

* ♦ 
**«**«** 4 ******** 



_ NO 

.*. 
C4 *. 
.* *. 

ARE TWO *. 

NonFS .*x. 

. IDENTICAL.* 



44 44 4F 44*4 44***** 

* « 

* * 

* SET ERil0R='0' *X. 

* * 

* » 

************ 4* 44* 



G4 •. 

.•ARE AT •. 
.• LEAST N •. NO 
•• ITERATIONS .*... 

•.PERFORMED.* 



X 
• •. 

H4 •. 

.* ARE *. 

.• GRADIENT • 

• .AND ARGUMENT 

•. CHANGE .• 

•.SMALL.* 

*. .* 

* YES 



♦ VALUE AND • 

• GRADIENT FCR 4 
•CUBIC'S MINIMUM* 
****«••• 4******** 



C5 *. 

.•IS LASI^. 

. • VALUE THE *. 

. CURRENTLY .4 

•.SMALLEST .* 

*. ONE . • 



* YES 



COMP 

♦•♦**FS ***••***♦* 

• ♦ 
*CnMP. CHANGE 0F» 

• ARGUMENT AND • 

• GRADIENT • 

• * 
***************** 



F5 *. 




.* 010 *. 




NO .* FUNCTION 


*. YES 


.. ♦. SIGNIFICANT, 


. *. ,. 


•.INCREASE . 


» 


♦. . ♦ 




*, . * 




* 




***♦ 




• * 




* El *X. . 




« * . 




♦ *♦♦ 




**«*«G 5 *«***»*** 41 



*UPDATE MATRIX H* 

* * 

* * 
***************** 



NO 

HS' *•. 

. * IS •. 
.* LIMIT OF 
.X*. ITERATIONS 
•.EXCEEDEO . 



. * GRADIENT *. NO 
. SUFFICIENT! V . *. .. 

•. SMALL ,* 



*****J344**4 4***4 

* 4 
4 * 

.X* SET ERRORs'O' ». 

* • 

* * 
***************** 



****4K2 ********** 

•F UNC T • 

. X* VALUE AND * 

* GRADIENT FOR * 

* OLD ARGUMENT * 
****4 444******4** 



RETURN 

*****J 4** *«*•**•* 

* * 

* RETURN • 
...X^ RFSULTAVT • 

* FUNCTION VALUE * 



***************** 



****K4***^***** 

* END OF * 
*PRDCEOURE FMFP * 

* • 
*•*«**«******** 



* SET ERROR='l' * 

* POOR • 

* CONVERGENCE * 

* * 
*•♦********«♦♦*** 
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• Subroutine RTF 



********** 



********* 



t ********************* 



CALCULATE ROOT OF GIVEN FUNCTION 

IF DPT = 'C 8Y LINEAR I NTERPOL ATION (SECANT METHOD) 

IF OPT = 'I' BY QUADRATIC INte? POL ATION (MULLER'S METHOD) 

IF OPT = '2' BY HYPEReOLtC INTEPPOLATION IHALLEY'S METHOD) 



/*********************************t»**^*!^'Mi*** 

PROCE DURE (X, F.FCT, LIMIT, OP T),. 
DECLARE 

(ERROR EXTERNAL, INCL.LOPT, OPT) 
CHARACTfcRU) , 
(STEP.CT.LIMITl 
BINARY FIXED, 

(X.F,T,Y,XX,DX,X1,X2,F1,F2,XK,X20,X21 
F10,F21,FF,XXX,TOL.MI,MA) 
BINARY FLOAT, 
/* BINARY FL0AT(53), 

FCT ENTRY!) RETURNS 
(BINARY FLOAT),. 
(BINARY FLOAT(53) ) , . 



*******^*»**** 



RTF 

**/<lTF 

*/RTF 

*/RTF 

*/RTF 

*/RTF 

*^RTF 

*/RTF 

**/RTF 

RTF 

OTF 



STEP =1, 

F,F2 -FCT(X2), 

INCLtERRDR=*C* 
CT =C,, 



=M1N(0.1,ABSIF) t , 
=MAX(1,A8S(X)),. 



T =X«-DX,. 

OX =-DX,. 
TEST.. 

Y =FCT(T),. 

STEP =STEPtI,. 
IF STEP GE LIMIT 
THEN GO TO EXIT,. 
IF INCL=M' 
THEN 00, . 

IF Y*FF LT 
THEN XXX =T,. 
ELSE GO TO SIGN,. 
END,. 
ELSE DO.. 

IF Y*F LE 
THEN DO, . 

INCL ='l',. 
XXX =X,. 
SIGN.. 



XX 
FF 



= T, 



END,. 

END*. 
IF ABS(Y) LT ABS(F) 
THEN DO, , 

X =T,. 

F =Y,. 

GO TO CHECK.. 

END, . 
IF INCL='l' 
THEN GO TO CHECK, . 
IF LOPT NE •$• 
THEN GO TO SEEK,. 
IF DX LT 
THEN GO TO SEEKl,. 
XI =X1+1,. 

OX =DX*DX,. 
IF XI LE Fl 
THEN GO TO SEEKl,. 
Fl =F1*2,. 
GO TO SEEK2,. 
CHECK.. 

TOL =IE-5*MA, . 
/*TOL =1E-12*MA,. 
IF A8S(0X) LE TOL 
THEN 00,. 

CT =CT+1,. 

IF ABS(Y) GT TOL 

THEN IF CT LE 5 

THEN GO TO CONT,. 

ELSE ERROR='W'f. 

GO TO RETURN, . 
CONT.. 

END,. 
ELSE CT =0,. 



XIO 
FIO 
XZ 
F2 



=T-X1,. 
=X2, . 
=F1,. 
=F2, . 
=X21,. 
=F21,. 
= T, . 



=Y. . 

X2l =X2-XI, . 

IF X2l= 

THEN GO TO EXIT,. 

F21 =fF2-Fl)/X21,. 

IF LOPT='l' 

THEN DO, . 

IF X20 NE 
THEN 00,. 



/'«SINGLE PRECISION VERSION 
/•DOUBLE PRECISION VERSION 



/•CALCULATE STARTING VALUE 



/•LOCATE BETTER POINT 
/*6Y SIMPLE SEARCH PROCESS 



RTF 
RTF 

RTF 

RTF 
RTF 
PTF 
/•S»/RTF 
/*0*/RTF 
PTF 
/•SINGLE PRECISION VERSION /*S*/RTF 
/"DOUBLE PRECISION VERSION /*D*/RTF 
/*IN1T. ITERATION COUNT »/PTF 
RTF 
*/RTF 
RTF 
RTF 

• /RTF 

• /RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 

• /RTF 

• /RTF 

RTF 
/•TERMINATE WITH ERROR = 'C* */<»TF 
/•TEST FOR PREVIOUS S IGM-CHANGE*/BTF 
RTF 
RTF 
=ITF 
RTF 
RTF 
RTF 

• /RTF 
RTF 

• /RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 



/•CALCULATE FUNCTION VALUE 
/•STEP ITERATION COUNT 



/•TEST FOR SIGN-CHANGE 



/♦MARK SIGN CHANGE 



/•TEST FOR IMPROVEMENT 



/•SEEK AT SYMMETRIC POINT 
/♦SEEK FARTHER AWAY 



/•STEP ODD INTEGER DENOMINATOR 



/•SINGLE PRECISION VERSION 
/•DOUBLE PRECISION VERSION 



=(F21-F10»/X20,. 
Y =F21tX21^T,. 
IF Y NE C 
THEN DO,. 

OX =F2/Y,. 

T =0.25-0X^T/Y,. 

IF T NL 

THEN DX =0X/(0.5*S0RT(T)), 

GO TO COMP,. 

END,. 
END, . 



END, 
IF LQPT=' 
THEN DO,. 



=F2-FC*F21/F10, 



♦ /RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 

♦ /RTF 
RTF 

♦ /RTF 
RTF 
RTF 

•/RTF 

RTF 

RTF 

/•S^/RTF 

/•D«/RTF 

RTF 

RTF 

RTF 

/•TERMINATE SUCCESSFULLY IF ♦/RTF 

/♦BOTH ARGUMENT-CHANGE AND */RTF 

/♦FUNCTION VALUE ARE SMALL ♦/RTF 

/•WITH WARNING IF ARGUMENT- */RTF 

/♦CHANGE ONLY IS SMALL REPEAT. •/RTF 

RTF 

RTF 

RTF 

RTF 

♦ /RTF 
RTF 
RTF 
RTF 
RTF 

♦ /RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 

•/RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 
RTF 

♦ /RTF 
RTF 



/♦SAVE OLD VALUES 



/♦STORE NEW VALUES 



/♦QUADRATIC INTERPOLATION 



/•HYPERBOLIC INTERPOLATION 



100 

110 

120 

13C 

1*0 

150 

16C 

170 

160 

19C 

200 

210 

220 

230 

240 

250 

260 

270 

280 

29C 

300 

31C 

320 

330 

340 

350 

360 

370 

380 

390 

400 

410 

42C 

430 

440 

450 

460 

470 

490 

490 

500 

51C 

520 

530 

540 

550 

560 

570 

58C 

590 

600 

610 

620 

630 

640 

650 

660 

670 

680 

690 

700 

710 

720 

730 

740 

750 

76C 

770 

780 

790 

800 

810 

820 

630 

840 

850 

860 

870 

880 

890 

900 

910 

920 

930 

940 

950 

960 

970 

980 

990 

1000 

1010 

1020 

1030 

1040 

1050 

1060 

1070 

1080 

1090 

1100 

1110 

1120 

1130 

1140 

1150 

1160 

1170 

1180 

1190 

1200 

1210 

1220 



le T NE 








RTF 


1230 


THEN OX =X2C*F2/T,. 








RTF 


1240 


IF DX NE 








RTF 


1250 


THEN GO TO COMP,. 








RTF 


1260 


END,. 








PTF 


1270 


IF F21=0 








RTF 


1280 


THEN If INCL='l' 








RTF 


1290 


THEN GO TO HALF,. 








RTF 


1300 


ELSE GG TO SEEK,. 








RTF 


1310 


DX =F2/F21,. 








RTF 


1320 


COMP.. 








RTF 


1330 


TOL =MAX(MI,1E-3)^MA,. 








RTF 


1340 


IF INCL NE 'l' 








RTF 


1350 


THEN IF A651DX) GT TOL 








RTF 


1360 


THEN IF DX LT C 








RTF 


1370 


THEN DX =-TOL,. 








RTF 


1380 


ELSE DX =TCL,. 








RTF 


1390 


T =X2-0X,. 








RTF 


1400 


IF INCL='l' 








RTF 


1410 


THEN IF (XX-T)^(XXX-T) GT 


/♦TEST 


IF INSIDE INTERVAL 


•/RTF 


1420 


THEN 








RTF 


1430 


HALF. . 








RTF 


1440 


T ={XX*XXX)*0.5,. 








PTF 


1450 


LOPT =OPT,. 








RTF 


1460 


GO TO TEST,. 








RTF 


1470 


EXIT.. 








RTF 


1480 


ERROR='f ',. 








RTF 


1490 


RETURN.. 








RTF 


1500 


END,. 


/•END 


OF PROCEDURE 


RTF 


♦ /RTF 


1510 



Purpose: 

RTF refines a given initial guess for a root of the 
general (transcendental) equation f(x) = using: 

linear interpolation if OPT='0' (secant method) 
quadratic interpolation if OPT='l' 
hyperbolic interpolation if 0PT='2' 

Usage: 

CALL RTF (X, F, FCT, LIMIT, OPT); 

X - BINARY FLOAT [(53)] 

Given initial guess for root of f(x) = 0. 

Resultant refined approximation for root of 

f(x) = 0. 
F - BINARY FLOAT D(53)] 

Resultant function value for calculated 

value of X. 
FCT - ENTRY (BINARY FLOAT [(53)] ) RETURNS 

(BINARY FLOAT [(53)]) 

Given function procedure for calculation of 

the function values f(x). It must be supplied 

by the user. 

Usage: 

FCT(T) 

FCT(T) - BINARY FLOAT [(53)] 

Resultant function value f(t). 
T - BINARY FLOAT [(53)] 

Given argument of fimction. 

LIMIT - BINARY FIXED 

Given bound for the number of function 

evaluations to be performed at most. 
OPT - CHARACTER(l) 

Given option for selection of iteration 

method. 
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Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR=' C means no convergence obtained within 
LIMIT function evaluations, possibly because of 
poor initial guess or unrealistically small value of 
LIMIT, 

ERROR='W' means small changes in successive 
refined approximations indicate covergence of method, 
while corresponding function values are not small 
enough. Possibly the function values cannot be 
obtained accurately enough by the user-supplied 
procedure FCT. The returned value of x has the 
absolutely smallest function value f(x) among all 
arguments used in the course of calculation. 

Any value of OPT different from '1' and '2' is treated 
as if it were ' 0' . 

Method: 

A refined approximation of the root is calculated as 
root of the linear fit through two successive ap- 
proximations if OPT='0' (secant method). 

The root of a quadratic fit through three successive 
approximations is used if OPT^'l' (MuUer's method). 

With 0PT='2' the refined approximation is 
calculated as root of a hyperbolic fit through three 
successive approximations. 

For reference see: 

J. F. Traub, " The Solution of Transcendental 
Equations" , edited by A. Ralston and H. S. Wilf, 
Mathematical Methods for Digital Computers , vol. 
2, pp. 171-184. 

Mathematical Background: 

Secant iteration method 

The linear interpolation polynomial throu^ two suc- 
cessive approximants is given by (Newtonian 
formulation) 

P(t) = f (x.)+f rx., x._^] (t-x.), 

where 

f(x.) - f(x._^) 



A refined approximation is obtained setting P(Xj.-|) 
= 0: 



x.^^ = x.-f(x.)/f[x., x._^],fori^2 



and 



f(x.) ^f(x._^) 



(2) 



['^i' Vi] 



The asymptotic order of convergence is p = 1. 62. 

Muller's iteration method 

The quadratic interpolation polynomial through 
three successive approximants is given by 

P(t) = f(x.) + frx.,x._^1 (t-x.) 

+ f[x.,x._^, x._J (t-x.)(t-x._^) ^3^ 

With the notation 

2w = f [x.. x._ J + f [x.. x._^, x._2] 



(x.-x. ,) 
1 1-1 



(4) 



this reads 

P(t) = f(x.) +2w (t-x.) + f Tx., x._^, x^_l 



(t-x.) 



(5) 



A refined approximation is obtained setting P(x. .) 



X. , = X. - w/l 
1+1 1 \ 



/f|-x..x._^,x._,,J 



or preferably 



x.^l=x. 



f(x.) 



v 



' wh+^l-f(x.)f |^x.,x._^,x. 
■ 7^ and f(x^) • f fx., Xj^_-j^, xj_2 
The asymptotic order of convergence is p = 1. 84. 



with w ■■ 



(6) 



<, w 



x.-x. , 
1 1-1 



(1) 
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Hyperbolic Interpolation iteration method 
Hyperbolic interpolation is defined through 

P(t) = (t-a) / (b+ct) 
with 



(bfc X ) f (x ) = X - a, for j = i, i-1, i-2. 



(7) 



A refined approximation is obtained setting 
P(Xi+i) = 0, that is, Xj^j = a. 

Symmetric formula: 

^i- (V2-'^i-l>/^<^i>^Vl- < VV2>/^<Vl) 

^V2<Vl-i)/f(V2) 

''i+l ^ ^-2-Vl)/f(^i)-^(V^i-2)/^(^i-P 

^-(x._^-x.)/f(x._2) 



(8) 



xj^.j^ is a weighted mean of xj, xj.j, Xj_2. 
Preferable is the equivalent unsymmetric formula: 



X. - X. „ 
i i-2 



1+1 i 






(9) 



with 



f(x._2)-f[x., x._^]^f(x.).fp._^.x._2]^0 

The asymptotic order of convergence is p = 1. 84. 

Programming Considerations: 

1. The three above-defined iteration methods 
(1), (6), and (9) are combined with a search meth- 
od that uses arguments 



(10) 



X ± 2 -A /(2i+l) for ( i = 0, 1, .... k 

jk =0, 1, ... 

until an argument t is found for which either 

|f(t)|<|f(x)| orf(t) • f(x) SO. 

The value of A used internally is A = min (0. l,lf(x)| 
2. If an interval (x^, Xy) enclosing a root has 



been found, that is, f(xi) • f(x^) < 0, then succes- 
sive approximants from one of the iteration meth- 
ods above must lie inside this interval. Otherwise, 
(xj+Xy)/2 is used as next approximation. The 
interval bounds for this bisection method are up- 
dated in the course of calculation. 

3. If no sign change has been located previously, 
the absolute argument change at a single iteration 
step is reduced to max (0. 001, A) • max(l, | X | ) 

if necessary, in order to avoid overshooting and 
overflow problems. 

4. If, in case of no previous sign change, the 
iteration method fails to give an argument xi+i 
for which either f(Xi+j) • f(xi) s or | f(Xi+-|^)| < 
|f(xi)| , then the next approximant is calculated by 
the search method (1). 

5. Calculation of the first approximant is based 
on the simple search method, while the second ap- 
proximant is calculated with the secant method. 

6. The convergence test used requires that both 
argument change and function value are absolutely 
less or equal to lO'^.max (1, | X| ) in single 
precision and 10~12.max (1, | X | ) in double preci- 
sion. If tiie argument change is absolutely less 
than or equal to this internal tolerance five times 
in sequence, while the function values are not 
small enough, then the currently best values x, 
f(x) are returned with ERROW='W'. 

7. The iteration process is terminated with 
EIlROR=' C if the number of function evaluations 
exceeds the user-specified limit LIMIT. 
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PiIUClDUKE RTF REFINES AN INITUL GUESS FOR A ROOT OF F(X)"0 J51N0 LINFARi 9U»0RATIC 3R HYPFRBOLU INTFRPOLATI ON 



♦ * 
« PROCEDURE RTF » 

* • 



*****B 1********** 
» INITIALIZE » 

• STEP=1 • 
t (ITERATION • 

* COUNT) » 
t • 



#*#**C1********** 
»£CI * 

• CALCULATE FlXl * 

• FOR INITIAL • 
» GUESS * 



»»*** 01*** ******* 

* PRESET * 

* EKKOR='0«t * 

* INACTIVATE * 
» BISECTION • 

* METHOD * 
»**♦»»*»*****»*** 



««««# tfl*** ******* 

* INIT lALIZE CT=0» 

* I COUNT OF * 

* SUCCESSIVE * 
» CLOSE * 

* ARGUNENTSl * 
#*******♦****»*** 

**** I 

* * . 

* Fl *.X. 

* « . 

**** 
SEEK X 

««***f I********** 

« INITIALIZE * 

* SIEPSIZE, * 
•ACTIVATE SEARCH*X. 
» PROCESS * 

* * 
•**«*•********»** 



SEtK2 X 

**«**« I*** ******* 

* CALCULATE * 

* SIEPSIZE, * 
..X* INITIALIZE * 

*CUUNT OF STEPS • 

* XI * 
«****«««*«***««** 



SttKl X 

*****H1********** 
•COMPUTE SEARCH * 
« ARGUMENT, * 
•CHANGE SIGN OF *X. 

* SIEPSIZE * 

• • 
«**«*****««**•*** 



TEST X 

«***4A2 ********** 
*PCT * 



..X»CALCUIATE FIX) *. 

. • FOR CURRENT * 

. * ARGUMENT * 

*•**••*«•*»**«**« 

• *** 



***** A3* ********* 



*STEP ITERAT ION • 
.X* COUNl STEP * 



***************** 



B2 *. 

. * OOES *. 

« ITERATION 

COUNT STEP 

*. EXCEED . 

• .LIMIT. * 

*. . * 

* NO 



X 

. *. 

C2 *. 

.•IS *. 

.« BISECTION *. NO 

METHOD .*. .. 

*. ACTIVE .* 



.* X* SET ERROR='C' *X. 

* • 

* * 
**♦****•***♦**•** 

* »*** 
. * * 

..X* K3 • 
* * 

**•• 
.* . 
C3 *. 



CONT 

*****l\4«* ******** 

* • 

* SAVE OLD • 
..X* VALUFS, STORE * 
. * NFW VALUES * 
, * * 
, ***************** 

*•** 

* * 
» A4 * 

* • 

**** , 



BA *. 
.* ARE ». 
YES .* *. 

......APP^OXIHA-ITS .* 

*.MUCH TOO .* 
• .CLOSE.* 



* NO 



.» HAS *. NO 

.X*. SIGN CHANGE .*... 
*. LDCATfO .* 



*****D2 •*****•*** 



*UPOATE INTERVAL* 
* BOUNDS » 



***************** 



SIGN X 

»****D3* ****••*»* 

* AaiVATE * 

* BISECTION * 

* METHOD, SAVE • 

* INTERVAL BOUNDS^ 

* * 
****«•«******«*** 



*****C4»*******^* 

• CALCULATE * 

• INCREMENT FROM * 
.* QUADRATIC •X. 

• INTERPOLATION • 

• • 
**•*••***«******* 



***^*0A****^***** 
« CALCULATE • 
*INCREMENT FROM • 
. ..* HYPFRBOLIC *X. 
* INTERPOLATION * 



. *. 

E2 ». 

.* HAS *. 

. • FUNCTION •. 

VALUE 

• .DECREASED.* 



F2 *. 
.•IS *. 
. * 81 SECTION *. YES 
METHOD .*.... 

*. ACTIVE .* 



♦****E3** ******** 

* SAVE CURRENT * 

* VALUES OF • 
.X* FUNCTION AND • 

» ARGUMENT • 

* • 
*•*•*****»*•****• 



CHECK X 

*****F3*»******** 

* CALCULATE * 

* INTERNA!. * 
. ..X* TOLERANCE FOR * 

* FOLLOWING TESTS* 



*•**•***«♦****♦** 



*****E A********** 

* CALCULATE • 
•INCREMENT FROM * 

* LINEAR »X. 

* INTERPOLATION * 

* * 
***««•**••*•*•*** 



***************** 



G2 *. 

.•IS ». 

. • SEARCH •. 

PROCESS .• 

• . ACTING .• 



.• ARGUMENT- •. YES 
CHANGE ...... 

•. SMALL .• 



COUP X 

•••••F^* •*•••**** 
*SET UP INTERNAL* 
*TESTVALUE TOL , • 

* INACTIVATE *. 
•SEARCH PROCESS • 

* * 
***************** 



•♦••*G «•••******• 

• STEP COUNT OF • 

• SUCCESSIVE • 
.X^CLOSE ARGUMENTS* 

• CT * 



****#K I********** 

* * 

* INITIALIZE * 
.* REFINEMENT OF * 

* STEPSIZE * 

* • 
*♦*♦••*****••***♦ 



H2 *. 

. • UA S •. 
NO .• SYMMETRIC •. 
...*. POINT ALL- . 
•. READY .* 
•. TRIED. * 
*. . • 
• YES 



•♦••»J2 •**»****♦* 

• DOUBLE * 

• STEPSIZF, • 

• UPDATE COUNT OF* 

• STEPS XI • 

• • 
••*•*••♦♦•••«♦••♦ 



K2 •. 

. * *. 

NO .* SHOULD • 

. ..•. STEPSIZE BE 
• . REFINFD .» 
♦. . • 

♦. . • 
* YES 



*****H3********** 
*INITIALIZE CT=0* 

• (COUNT OF • 
. • SUCCESSIVE • 

• CLOSE • 

• ARGUMENTS) • 
••••****••*•***** 



****•*•*•*••«•**• 



.*. 

HA *. 
.* IS *. 

YES .* FUNCTION *. 
....*. VALUE 

*. SMALL .* 



J A •• 

.« IS •. 
NO .• COUNT CT •. 
...•.GREATER THAN .• 
». FIVE .• 
•. .* 



• AA • 

• * 
**** 



•••*K3* •*****•• 

• END OF • 

• PROCEOJRE RTF tX. 

• • 
•••*•••••♦*•••• 



«****K 4»********* 

* * 

* • 
.» SET E«ROR='W> * 

* * 

* « 
*****••**••••**** 



C5 *. 
.•SHOULD •. 
YES .• AND COULD *. 

«. ITERATION BE . • 

*. QUADRATIC. • 



05 *. 

.•SHOULD •. 
YES .• AND COULD •. 
.... •.ITERATION BE . 
•.^YPERBO- .* 
•. Lie . • 
•• . * 
• NO 



. ♦. 

F? *. 

. * I S ». 

. * LINEAR *. 

.INTERPOLATION.* 

•.POSSIBLE .• 

*. . * 

». . * 



F5 *. 
. * IS •• 

NO .* BISECTION •. 
...*. MFTHOD 

». ACTIVE .* 



**•• 

* * 

* Fl • 

* * 
*•** 



•USE MIDPOINT OF* 

* INTFRVAL AS *. 

* NEXT ARGUMENT » 

* • 
***********•••••* 



. NO 

. *. 

H5 *. 

. • IS •. 

. • ARGUMENT •. YES 

.X^. WITHIN .•... 

♦.INTERVAL .* 



****«J5 •****•••** 

* REDUCE * 

* INCREMENT IF • 

* NECESSARY TO *. 

* TOL OR -TOL » 

* * 
***••••••***••••• 



.YES .« BI SECTION ». 
...... MFTHOD 

*. ACTIVE .* 
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Subroutine ETFD 



RTFD.. 








RTFO 


10 


/**«V **»«««»«««««»«**»*«*««*«»**«•**»*««***.***«******«*«*****«*««**«* 4./RTF0 


20 


/* 








♦/RTFO 


30 


/* 


CALCULATE ROOT OF GIVEN FUNCTION USING DERIVATIVE VALUES 


•/RTFO 


40 


/* 


IF OPT = 'C* 6V 


LINEAR INTERPOLATION (NEHTON METHOD) 


♦/RTFD 


50 


/* 


IF OPT = *!■ BY 


INVERSE QUADRATIC INTERPOLATION 


*/RTFD 


60 


/* 


IF OPT = ■2* BY 


HYPERBOLIC 


INTERPOLATION IHALLEY METHOD) 


♦/RTFO 


70 


/* 








*/RTFO 


80 


/«*«[« ****««« 4: ***«*****«*«*»************«***«*«*««***********« littov^tffi/RTFD 


90 


PROCEDURE(X,F,OF,FCI 


LIMIT.OPT) 




RTFD 


100 


DECLAPE 






RTFD 


110 




(ERROR EXTERNAL 


INCL. LOPT. 


3PT) 


RTFD 


120 




CHARACTERd) t 






RTFO 


130 




(STEP, CT, LIMIT) 






RTFD 


140 




BINARY FIXED, 






RTFO 


150 




(X,F,T,Y,XX,DX. 


<1,X2,F1.F2 


DF1,DF2,0Y,DF,T0L,MI,MA,FF,XXXI 


RTFD 


160 




BINARY FLOAT, 




/♦SINGLE PRECISION VERSION /* 


S^/RTFD 


170 


/• 


BINARY FLOAT(52 




/♦DOUBLE PRECISION VERSION /• 


0^/RTFD 


180 




FCT ENTRY,. 






RTFD 


190 


STEP 


= 1». 






RTFD 


200 


X2 


= X, . 






RTFD 


210 


CALL 


FCT(X2,F2,OF2), 




/♦CALCULATE STARTING VALUE 


*/RTFO 


220 


F 


=F2,. 






RTFD 


230 


Df 


=0F2,. 






RTFO 


240 


INCL 


ERROR-TN. 






RTFO 


250 


CT 


=C,. 






RTFO 


260 


LOPT 


= "3',. 




/♦NO PREVIOUS VALUE AVAILABLE 


♦/RTFD 


270 


GO TO CDMP,. 




/♦USE NEHTON METHOD 


*/RTFD 


280 


SEEK.. 






/♦LOCATE BETTER POINT 


♦/RTFD 


290 


Fl 


= 1,. 




/♦BY SIMPLE SEARCH PROCESS 


*/RTFO 


300 


LOPT 


='S',. 






RTFO 


310 


SFEK2.. 








RTFD 


320 


DX 


=MI/F1,. 






RTFO 


330 


XI 


= lt. 






RTFO 


340 


SEEK!.. 








RTFD 


350 


T 


=X+DX,. 






RTFO 


360 


DX 


=-DX,. 






RTFO 


370 


TEST.. 








RTFD 


380 


CALL 


FCT(T,Y,DY),. 




/♦CALCULATE FUNCTION VALUE 


♦/RTFO 


390 


STEP 


=STEP+1,. 




/♦STEP ITERATION COUNT 


*/RTFD 


400 


IF STEP GE LIMIT 






PTFO 


410 


THEN 


GO TO FXIT,. 




/♦TERMINATE WITH ERROR ='C» 


*/RTFO 


420 


IF INCL='l' 




/♦TEST FOR PREVIOUS SIGN-CHANGe*/RTFD 


430 


THEN 


DO,. 






RTFD 


440 




IF Y*FF LT 






RTFD 


450 




THEN XXX =Tt. 






PTFO 


460 




ELSE GO TO SIGN 


, 




RTFD 


470 




END,. 






RTFO 


480 


ELSE 


DP.. 






RTFO 


490 




IF Y*F LE C 




/♦TEST FDR SIGN-CHANGE 


•/RTFO 


500 




THFN DO,. 






RTFD 


510 




INCL ••!', 




/♦MARK SIGN CHANGE 


•/RTFD 


520 




XXX =X,. 






RTFO 


530 


SIGN.. 








OTFD 


540 




XX =T,. 






RTFO 


550 




FF =Y,. 






RTFO 


550 




END,. 






RTFD 


570 




END,. 






RTFO 


580 


IF ABSIY) LT ABSIF) 




/♦TEST FOR IMPROVEMENT 


♦/RTFO 


590 


THEN 


00,. 






BTFO 


600 




X =nT,. 






RTFO 


61C 




F =y,. 






RTFO 


620 




OF =DY,. 






RTFD 


630 




GO TO CHECK,. 






RTFD 


640 




END,. 






RTFD 


650 


IF INCL=M' 






RTFD 


660 


THEN 


GO TO CHECK,. 






RTFD 


670 


IF LOPT NE 'S' 






RTFO 


680 


THEN 


GO TO SEEK,. 






RTFO 


690 


IF DX LT C 






RTFD 


70 C 


THEN 


GO TO SEEKl,. 




/♦SEEK AT SYMMETRIC POINT 


•/RTFO 


710 


XI 


=Xl*l,. 






RTFO 


720 


OX 


=OX+DX,. 




/♦SEEK FARTHER AWAY 


*/PTFD 


730 


IF XI LE Fl 






RTFD 


740 


THEN 


GO TO SEEKl,. 






RTFD 


750 


Fl 


=FH-2,. 




/♦STEP ODD INTEGER DENOMINATOR 


♦/RTFD 


76C 


GO TO SEEK2,. 






RTFO 


770 


CHECK.. 








PTFD 


780 


TOL 


=1E-5*MA,. 




/♦SINGLE PRECISION VERSION /♦S^/RTFO 


790 


/*TOL 


=1E-12*MA,. 




/♦DOUBLE PRECISION VERSION /*0^/RTFD 


800 


IF ABSIOXl LE TOL 






PTFO 


810 


THEN 


DO,. 






RTFO 


820 




CT =CT+1,, 






RTFO 


BBC 




IF ABS{Y» GT TCL 


/♦TERMINATE SUCCESSFULLY IF 


•/RTFD 


840 




THEN IF CT LE 5 




/♦BOTH ARGUMENT-CHANGE AND 


•/RTFO 


850 




THEN GO TO CONT 




/♦FUNCTION VALUE ARE SHALL 


♦/RTFD 


860 




ELSE ERROR='W', 




/♦WITH WARNING IF ARGUHENT- 


♦/RTFD 


670 




GO TO RETURN,. 




/♦CHANGE ONLY IS SMALL REPEAT. 


"/RTFD 


880 


CONT.. 








RTFO 


89P 




END,. 






RTFO 


900 


ELSE 


CT =0,. 






RTFO 


910 


XI 


=X2,. 




/♦SAVE OLD VALUES 


♦/RTFO 


920 


Fl 


=F2.. 






RTFD 


93C, 


DFl 


=DF2,. 






BTFD 


940 


X2 


=T,. 




/♦STORE NEW VALUES 


♦/RTFD 


950 


F2 


=Y,. 






RTFO 


960 


DF2 


=DY,. 






PTFD 


970 


DV 


=X2-X1,. 






RTFO 


980 


IF DV= 






RTFD 


990 


THEN 


GO TO EXIT,. 






PTFDIOOO 


COMP.. 








RTFDIOIO 


HA 


=MAX(l,ABS(xn, 






RTF01020 


MI 


=H[NI0.1,ABS(F)),. 




RTF01030 


IF DF2 NE 






RTF01040 


THEN 


DO,. 






PTF01050 




DX =F2/DF2,. 




/♦NEWTON METHOD 


♦/RTFD1060 




IF LOPT NE '0' 






RTF0107C 




THEN DO,. 






RTFD108C 




T =tF2-Fl)/0Y,. 




RTFD1090 




Y =DF2- 


r,. 




RTFDllOO 




T =DX*lDFl-T+y*V)/(DF2*Dy),. 


*?TFD1110 




IF LOPTs'l 




/♦MODIFICATION.. 


♦/RTF0112C 




THEN DX 


-0X*(1+T),. 


/♦INVERSE QUADRATIC INTERPOLAT 


.♦/RTFD113C 




IF L0PT='2 




/♦MODIFICATION.. 


•/RTFD1140 




THEN IF T NE 1 


/♦HYPERBOLIC INTERPOLATION 


•/RTF01150 




THEN DX 


=0X/(1-TJ,. 




RTFD1160 




END,. 






RTFDH70 




LOPT =OPT,. 






PTFD1180 




TOL =MAXIMI,ie 


-3)*MA,. 




RTF01190 




IF INCL NE '1' 






RTF01200 





THEN 00,. 




RTFD121C 




IF ABSIOXl GT TOL 




RTFD1220 




THEN IF OX LT 




RTFD1230 




THEN OX —TOL,. 




PTFD124C 




ELSE DX = TOL.. 




RTF01250 




END,. 




RTF0126C 




T =X2-DX,. 




PTFD1270 




IF 1NCL='1' 




RTFD1280 




THEN IF (XX-T)»1XXX-T) GT 


/♦TEST IF INSIDE INTERVAL 


♦/RTFD1290 




THEN 




RTFDL3DC 


HALF.. 






RTFD1310 




T =(XX+XXX)^0.5,. 




PTF01320 




GO TO TEST,. 




RTFD133C 




END,. 




RTFD13'iC 


ELSE 


IF INCL='l' 




PTF01350 


THEN 


GO TO HALF,. 




RTF01360 


ELSE 


GO TO SFEK,. 




RTFD13TC 


EXIT.. 






PTFD139C 


ERR0R='C'.. 




RTFD1390 


RETURN. 






RTFD1400 


END. 




/♦END OF PROCEDURE RTFO 


♦/RTFD1410 



Purpose: 

RTFD refines a given initial guess for a root of the 
general (transcendental) equation f(x) = using: 
Linear interpolation if OPT>='0' (Newton method) 
Inverse quadratic interpolation if OPT^'l' 
Hyperbolic interpolation it OPT=»2' 

Usage: 

CALL RTFD(X, F, DF, FCT, LIMIT, OPT); 



X- 



DF- 



FCT. 



LIMIT - 



OPT 



BINARY FLOAT [(53)] 
Given initial guess for root of f(x) 
= 0. 

Resultant refined approximation for 
root of f(x) = 0. 
BINARY FLOAT [(53)] 
Resultant function value f(x) for 
returned X. 
BINARY FLOAT [(53)] 
Resultant value of derivative f'(x) 
for returned X. 

ENTRY (BINARY FLOAT [(53)1 
BINARY FLOAT [1,53)'] , BINARY 
FLOAT [(53)] ) 

Given procedure for calculation of 
values f(x), f'(x). It must be sup- 
plied by the user. 

Usage: 

CALL FCT(X,F,DF); 

X- BINARY FLOAT [(53) ] 

Given argument value. 
F - BINARY FLOAT [(53)] 

Resultant function value f(x). 
DF - BINARY FLOAT [(53)] 

Resultant derivative value f (x). 
BINARY FIXED 

Given bound for the number of function 
evaluations to be performed at most. 
CHARACTER (1) 

Given option for selection of iteration 
method. 
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Remarks: 

If no errors are detected in the processing of data, the 
error indicator, ERROR, is set to zero. The follow- 
ing constitute t possible error conditions that may 
be detected: 

ERROR=' C - means no convergence is obtained 
within LIMIT function evaluations, 
possibly because of poor initial guess 
or unrealistic small value of LIMIT. 

ERROR='W' - means that small changes in succes- 
sive approximations indicate cover- 
gence of method, while corresponding 
function values are not small enough. 
Possibly the function values cannot 
be obtained accurately enough by the 
user-supplied procedure FCT. 

The returned value of X has the 
absolutely smallest function value 
f(x) among all arguments tried during 
the iteration process. 

Any value of OPT different from '1' and '2' is treated 
as if it were ' 0' . 



The asymptotic order of convergence is p = 2. 

Inverse quadratic interpolation 

Let X = F(y) denote the inverse function of y = f(x). 
The quadratic poljmomial Q(y) passing throu^ point 
yi, xj with derivatives F '(y^), F" (yj) is given by 



Q(y) = F(y.) + F Vj) (y-Yj) + ^ (y^) (y - y/ ^g) 

A refined approximation is obtained setting x^^.-^ 
= Q(0): 

x.^,= F(y.)-F'(y.)y.+|^(y.)y.2 (3) 



From the identity x = F(f (x)) follows easily: 
dF , , df 1 



F'(y) 



F" (y) 



dy 



If 
dy^ 



1 /^ - -- 
' dx f'(x) 



f" (X) 



(f'(x))^ 



Method: 

A refined approximation of the root is calculated 
using Newton's method if OPT>'0', higher-order 
methods doing inverse quadratic interpolation if 
OPT='l', and hperbolic interpolation if 0PT='2'. 
With the higher-order methods the second derivative 
is estimated from a cubic interpolation polynomial 
through two successive approximations. 

For reference see: 

J. F. Traub, "The Solution of Transcendental Equa- 
tions", edited by A. Ralston and H. S. Wilf, Math- 
ematical Methods for Digital Computers, vol. 2, pp. 
171 - 184. 

Mathematical Background: 

Newton' s iteration method 

The linear interpolation polynomial passing through 
x{, f(xi) with derivative f (x.) is given by 



Hence 



P(t) = f(Xj)+f'(X.) (t-x.) 



(1) 



A refined approximation is obtained setting P(Xj^j) 
= 0: 

Vl " '^i " ^('^i)/* H)' for i si and f '(x^) ¥ 0. 



f(x.) f(x.) f"(x.) 

= X. --TTT^ (1 +77rr^ ^TTrT— r ) 



i+1 i f '(X.) 
1 



f'(x.) 2f'(x.) 
1 1 



(4) 



The asymptotic order of convergence is p = 3. 
Hyperbolic interpolation (Halley' s iteration method) 
Hyperbolic interpolation is defined by 

P(t) = (t-a)/(bf ct) (5) 

with 



P(x.) = f(x.), P '(x.) = f '(x.), P"(x.) = f" (Xj) 



A refined approximation is obtained setting P(xi+.j^) 
= 0, that is, Xj^j^ = a. 

From 

P(t) (b4-ct) = t-a follows, by differentiation, (6) 
f(X][)(bf cxj) = Xj[-a 

f'(Xi)(b4-CXi)=l-f(Xi)- c 

f"(Xi)(bfcxi)= -2f'(Xi) • c 
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and from the last two equations 
2f'(x.) 

bf ex = 2 

f(x.)f"(x.)-2(f'(x.)) 



and 



and 



x.^, = X. - 
H-1 1 



f(x.) 



f(x ) f" (X ) 
f'(x,) ' 



(7) 



2f'(x^) 



The asymptotic order of convergence is p = 3. 
Estimation of second derivative 

A cubic interpolation polynomial passing through 
points xj, f(xi) and x^.j, f(Xi_]^) is of the form 

P(X) = f(x.) + (X-X.)f '(X.) + (Y(X-X.)^ 



+ iS(x-x.) (x-x^_^) 



(8) 



a 



and 



P(x.) = f(x.) and P'(x.) = f '(x.) are already 
satisfied. If we set 

P(x._j) = f(x._^) and P '(x._^) = f '(x._^) then 

f[x., x._j]- f'(x.) 



X. , - X. 

1-1 1 



p = 



f'(x.) + f'(x._^)-2f[;x..x._^;] 



(x. , - x.) 
1-1 1 



The second derivative f " (x.) is estimated by 
P"(x.) = 2 (a + (S(x.-x._p) = 24f'(x.) 

f(x^_^)-3f[...x._^3 



-i>-^^[VVi] \ 

(X. - xj_^) ; 



(9) 



Derivative estimated Iteration methods 



Replacing f"(xj) in (4) and (7) by P"(Xi) gives 
f(x.) 
'^i+l^'^i'lM^ * 

/ f(x^) 2f'(Xj)+f'(x._^)-3f [x.,x._^]\ 

V ■" fVJ) (Xj - Xj ^)f '(x.) ) 

(4-) 



f(x.) 
Vl ^ ^"f>J 



f(x.) _2f'(Xj) + f'(x._^) - 3f[x., x._^] 

^" FV)' (x.-x. Jf '(X) 

^1 ' 1 1-1 1 (71) 

The asymptotic order of both these iteration meth- 
ods is p = 2.73. 

Programming Considerations: 

1. The three above-defined iteration methods (1), 
(4 ), and (7*) are combined with a search method 
that uses arguments 

x+2''- A/(2i+l) forj^°' J'""'' (10) 

until an argument t is found for which either 

|f(t)| <|f(x)l or f(t) • f(x) < 0. 

The value of A used internally is A = min (0. 1, 
|f(x)l). 

2. If an interval (x^.Xy) enclosing a root has been 
found, that is, f(xj) • i(x^) < 0, then successive 
approximants from one of the iteration methods 
above must lie inside this interval. Otherwise, 

(xi + Xy)/2 is used as the next guess. The interval 
bounds for this bisection method are updated in the 
course of calculation. 

3. If no sign change has been located previously, 
the absolute argument change at a single iteration 
step is reduced to max (0. 001, A) • max (1, | x | ) if 
necessary, in order to avoid overshooting and over- 
flow problems. 

4. If, in case of no previous sign change, the 
iteration method fails to give an argument for which 
either f(Xi+j) • f (xj) < or | f(Xi+ j) | < |f(Xi) | the next 
approximation is calculated by search method (1). 

5. Calculation of the first approximant is based 
on Newton's method in all cases, while for those 
following, the higher-order iteration methods are 
used if specified. 

6. The convergence test used requires that both 
argument change and function value are absolutely 
less than or equal to 10"^ max (1, | x |) in single 
precision and 10"^^ j^ax (1, | x | ) in double precison. 
If the argument change is absolutely less than or 
equal to this tolerance five times in sequence, while 
the function values are not small enough, then the 
currently best values x, f(x) and f ' (x) are returned 
with ERROR='W. 

7. The iteration process Is terminated with 
ERRORS' c if the number of function evaluations 
exceeds the user-specified limit LIMIT. 
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PKJCtDUKt kFFO refines AN INIIUL GUESS FOR 4 ROOT OF F(X)=0 JSING LINFAR, INKFRSF QUADRATIC OS HYPEIBOLi: INTERPOLATION 



***«A1********* 

•PKuCbOURt RTfD • 
« « 



9**** Hi********** 

• INITIALIZE • 
t STEP=1 » 

• lUERATION * 

* COUNT) » 

* * 
***************** 



*****ci********** 

• ftl • 

• CJMP. VALUES F » 

• AND F* FOR » 

• INITIAL GUESS » 
***************** 



*****0l********** 

* PRESET » 
» ERROR='C', * 
« INACTIVATE * 

• BISECTION * 
» METHOD • 
***************** 



*****ei********** 

* INITIALIZE CT'0» 
» ICOUNT OF ♦ 

* SUCCESSIVE •. 
» CLOSE • 

* ARuUMENTS) « 
***************** 

**** 



TEST X 

*****k2 ********** 
WCT » 

..X»COMP. VALUES F *. 

• AND F • FOR • 

. CURRENT ARGUC. » 

. ***************** 

**** 



***** t^********** 



♦ STEP ITFRATION * 
.X* COUNT STEP * 



***************** 



com 

**#«*A t^********** 

* * 

* 5AVF OLD * 
..X» VALUFS, STORF * 
. * MFH VALUES « 

* * 
***************** 



B2 ♦. 

. » DOE S •. 
. • ITERATION ». YES 

. COUNT STEP .* 

*. EXCEED .» 
♦ .LIMIT. ♦ 
*. . ♦ 
♦ NO 



. ♦ BISECTION ♦. NO 
METHOD .». .. 

». ACTIVE .♦ 



FXIT 

♦♦♦♦*B3^^^^^^^^^^ 



.X^ SET ERROR='C' ♦X ♦. 

♦ ♦ 

* ♦ 
♦«♦♦♦«♦*««*«*««** 

1 *♦♦♦ 

♦ ♦ 
..X^ K3 ♦ 

♦ ♦ 
♦♦♦• 

.♦. 
C3 ♦. 



APPR0XI1ANTS . 

♦.MUCH TOO .* 

♦ .CLOSF.^ 



.♦ J AS ♦.NO 

.X*. SIGN CHANGE .♦... 
♦ . LOCATED .♦ 



♦♦*«*D 2 »♦♦♦♦♦♦♦** 



♦UPDATE INTFRVAL^ 

♦ BDuros ♦ 



♦♦♦♦♦*♦♦♦♦♦♦♦♦♦♦♦ 



SIGN 

***** D3^*^^^^^*«^ 

♦ ACTIVATE ♦ 

♦ BISECTION ♦ 

♦ MET Hon, SAVE * 

♦ INTERVAL BOUNDS^ 

♦ ♦ 
♦♦♦♦♦«♦♦♦«♦♦♦♦♦♦♦ 



E2 ♦. 

. ♦ HAS ♦. 

FUNCTION 

VALUE 

.DECREASED. 



♦ Fl ♦. 



* f, * 



**** 
**** 
SEEK X 

♦♦♦♦♦F !♦♦♦♦♦♦♦♦♦♦ 

♦ INITIALIZE • 

♦ SIEPSIZE, ♦ 

♦ ACTIVATE SEARCH»X... 

♦ PROCESS ♦ 



♦♦♦«♦♦♦♦♦*♦♦♦♦♦♦♦ 



i ttK 2 X 

♦♦♦♦♦G !♦♦♦♦♦♦♦♦♦♦ 

♦ CALCULATE ♦ 

♦ SIEPSIZE, ♦ 
..X^ INITIALIZE ♦ 

♦ COUNT OF STEPS ♦ 

♦ XI ♦ 

♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 



SEtKl X 

♦♦♦♦♦Hl^** ♦♦♦♦♦♦♦ 
♦COMPUTE SEARCH ♦ 

♦ ARGUMENT, ♦ 
♦CHANGE SIGN OF ♦X. 

♦ STEPSIZE ♦ 

♦ ♦ 
♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 



♦ ♦♦♦ 

♦ ♦ 

♦ A2 ♦ 

♦ ♦ 
♦♦♦♦ 



BISECTION ♦. YES 
METHX ...... 

• ACTIVE .* 



♦♦♦♦♦E3^^^^^^^^^^ 

♦ SAVE CURRENT ♦ 

♦ VALUES OF ♦ 
.X^ FUNaiON AND ♦ 

♦ ARGUMENT ♦ 

♦ ♦ 
♦♦♦♦♦♦♦♦♦♦♦♦♦*♦♦♦ 



CHECK 

♦♦♦♦♦F3 ♦♦*♦♦♦♦♦♦♦ 

♦ CALCULATE ♦ 

♦ IfiTERNAL ♦ 
. ..X^ TOLERANCE FOR ♦ 

♦FOLLOWING TESTS^ 



♦♦♦♦«C4^ ♦♦♦♦♦♦♦♦♦ 

♦ CALCULATE ♦ 
♦INCREMENT FROM ♦ 

.♦ INVERSE 

♦ QUADRATIC 

♦ MTERPOLATION ♦ 
♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 



♦ X. 



♦♦♦♦♦0 <(♦♦♦♦♦♦♦*♦♦ 

♦ CALCULATE ♦ 
♦INCREMENT FROM ♦ 

..♦ HYPFRBOLIC ♦X. 

♦ INTFRPOIATION ♦ 

♦ ♦ 
♦♦♦♦♦«♦«♦♦♦♦♦«♦** 



♦♦♦♦♦E4^^ ♦♦♦♦♦♦♦♦ 

♦ CALCULATE ♦ 

♦ INCREMENT FROM ♦ 

♦ LINEAR ♦X. 

♦ INTFRROLATION ♦ 



C5 ♦. 

.♦SHOULD ♦. 

. ♦ AND COULD ♦. 

.ITERATION BE .♦ 

♦. QUADRATIC. ♦ 

♦. . ♦ 



r)5 *. 

. ♦SHOULD ♦. 
YES .♦ AND COULD ♦. 
.... ♦.ITERATION BF .♦ 
♦.HYPERBO- .♦ 
♦. Lie . ♦ 



***************** 



G2 ♦. 
.♦IS ♦. 
NO .♦ SEARCH ♦. 
. ..♦. PROCESS .♦ 

♦. ACTING .♦ 



***************** 



G3 ♦. 
.♦ IS ♦. 
.♦ ARGUMENT- ♦. YES 
♦. CHANCE ...... 

♦ . SMALL .♦ 



COMP X 

*****f It********** 
♦ SET UP INTERNALS 
♦TESTVALUE TOL , ♦ 

..X^ INACTIVATE ♦. 

. ♦SEARCH PROCESS ♦ 

. ♦ ♦ 

♦«♦♦♦♦*♦«♦♦«*«*** 



*****(;^********** 

♦ STEP COUNT OF ♦ 

♦ SUCCESSIVF ♦ 
.X^CLOSF ARGUMENTS^ 

♦ CT ♦ 



♦♦♦♦♦K !♦♦♦♦♦♦♦♦♦♦ 

♦ ♦ 

♦ INITIALIZE ♦ 
.♦ RtflNEMENI OF ♦ 

♦ ilEPSIZE ♦ 

♦ ♦ 
♦♦*♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 



H2 ♦. 
.♦ WAS ♦. 
NO .♦ SYMMETRIC ♦. 
...♦. POINT ALL- .♦ 
♦ . READY .♦ 
♦.TRIED. ♦ 
♦. . ♦ 
♦ YES 



♦♦♦♦♦J2 ♦♦♦♦♦♦♦♦♦♦ 

♦ DOUBLE- ♦ 

♦ STEPSIZE, ♦ 

♦ UPDATE COUNT OF^ 

♦ STEPS XI ♦ 

♦ ♦ 
♦♦♦*♦*♦♦*»*♦**«♦* 



♦♦♦♦♦H3^^^^^^^^^^ 

♦ INITIALIZE CI=0^ 

♦ ICOUNT OF ♦ 
...♦ SUCCESSIVE ♦ 
. ♦ CLOSE ♦ 
. ♦ ARGUMENTS) ♦ 
X ♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 

♦ ♦♦♦ 

♦ ♦ 

♦ A* ♦ 



X 
. ♦. 



NO .♦ SHOULD ♦ 
...♦. SIEPSIZE BE 
♦ . REFINED .» 



*♦♦♦ , 
RETURN 

X 
♦♦♦♦K3^^^^^^^^^ 

♦ END OF ♦ 

♦ PROCEDURE RTFO ♦X. 

♦ ♦ 
♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 



♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 



.♦. 

H4 ♦. 
.♦ IS ♦. 
YES .♦ FUNCTION ♦. 

♦. VALUE .♦ 

♦. SMALL .♦ 
♦. .♦ 

♦. .♦ 
♦ NO 



NO .♦ COUNT CT ♦. 
...♦.GREATER THAN .♦ 
♦. FIVE .♦ 



♦♦♦♦ 

♦ 
' A4 ♦ 
[ ♦ 

♦♦♦♦ 



*♦«««< if********** 

* * 

* * 
.* SFT ERROR='H' ♦ 

♦ ♦ 

♦ ♦ 
***************** 



NO 



E5 ♦. 

. ♦ IS ♦. 

YES .♦ LI NFAR ♦. 

.... ♦.INTERPCLATICK.^ 

♦.POSSIBLE .♦ 

♦. , ♦ 



F5 ♦. 

. ♦ IS ♦. 
NO .♦ BISECTION ♦. 
...♦. METHOD .♦ 

♦. ACTIVE .♦ 
♦. . ♦ 

X ♦. .♦ 

♦♦♦♦ ♦YES 

♦ ♦ 

♦ Fl ♦ 

♦ ♦ 
♦ ♦♦♦ 

HALF X 

♦♦♦♦♦G5 ♦♦♦♦♦♦♦♦♦♦ 

♦ ♦ 

♦ USE MIDPOINT OF^ 

♦ INTERVAL AS ♦. 

♦ NEXT ARGUMENT ♦ 

♦ ♦ 
♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 



H5 ♦. 

.♦IS ♦ 

. ♦ ARGUMENT 

WI THI N 

♦.I NTERVAL 

♦. . ♦ 

♦. . ♦ 



♦♦♦♦♦J5 ♦#♦♦♦♦♦♦♦♦ 

♦ REDUCE ♦ 

♦ INC RF ME NT IF ♦ 

♦ NFCFSSARY TO ♦. 

♦ TOL OR -TOL ♦ 

♦ ♦ 
♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦ 



K5 ♦. 

. ♦ IS ♦. 

. ♦ BISECTION ♦. 

METHOD .< 

♦. ACTIVE .♦ 

♦. . ♦ 
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Systems of Ordinary Differential Equations 



• Subroutine DERE 



OEPc 






DERE 10 


/****** 


«*«**«*******«***««****«**«** 


*******:*«»********««*«*****«t*«*|>*/OERE 20 1 


/♦ 






♦/DERE 30 


/* 


PERFORM ONE INTEGRATION STEP 


FOR A SYSTEM OF ORDINARY DlF- 


♦/DERE 40 


/* 


FERENTIAL EQUATIONS USING RATIONAL EXTRAPOLATION TECHNIQUE 


♦/DERE 50 


/* 






♦/DERE 60 


/lK*«»*****aS****«:4:*«»*«>«4l «*«*•« ****** 


**«******««*«*««***************«*/OERE 70 1 


PR0CE0URE1F.N,H,X,Y,EPS),. 




DERE 80 


DECLARE 




DERE 90 




F ENTRY, 


/«Y' = FIX, VI GIVEN OOE-SYSTEH 


♦/DERE 100 




(ERROR EXTEPNALtCONV) CHARACTEPll), 


DERE 110 




(EPS.YM(N).FMH.SQMH.FHM,SQHI, 


OSOMI) 


DERE 120 




BINARY FLOAT, 




DERE 130 




(H,X,Y(*I,¥I,DY(N1,Z(N»,0Z(N) 


,LX.VC(N») 


DERE 140 




BINARY FLOAT, 


/*SINGLE PRECISION VERSION /♦$*/0eR6 150 1 


/» 


BINARY FLOAT(53) , 


/♦DOUBLE PRECISION VERSION /♦0»/DERE 160 | 




(LH,HA,CItBl,V,FO(NI,FE(N),ZI 


,CMI.OI,U. 


DERE 170 




0T(5*N1 t 


/♦SINGLE PRECISION VERSION /*S*/OERE IBO 1 


/* 


OT(in*N)) 


/♦DOUBLE PRECISION VERSION /*D*/DER£ 190 | 




BINARY FLnAT(53) , 




DERE 200 




(N,RR,CC,LN,OtAG,HSTEP,M,HH,I 


,J) 


DERE 210 




BINARY FIXED,. 




DERE 220 


LN 


=N, . 




DERE 230 


ERROP='S',. 


/♦MARK ILLEGAL SPECIFICATION 


♦/DERE 240 


If LN LE C 


/♦TEST SPECIFIED DIMENSION 


♦/DERE 250 


THEN 


GO TO EXIT.. 




DERE 260 


LH 


=H, . 


/*INIT. LOCAL STEPSIZE 


♦/DERE 270 


HSTEP=C,. 


/♦INIT. COUNT HALVING STEPSIZE 


♦/DERE 280 


IF LH= 


/♦TEST SPECIFIED STEPSIZE 


♦/DERE 290 


THEN 


GO TO EXIT.. 




DERE 300 


EfiROR = 'CS. 


/♦PRESET ERROR INDICATOR 


♦/DERE 310 


CALL 


F(X,Y,0Y1,. 


/♦DERIVATIVE FOR INITIAL VALUES^/OERE 320 | 


IF ERRO!^ NE '0* 




DERE 330 


THEN 


GO TO EXIT,. 


/♦TERMINATE IF ERROR IN F(X.V) 


♦/DERE 340 






/♦ 


*/DERE 350 


HALF.. 




/♦START OF ITERATION LOOP 


♦/DERE 360 


CONV 


= 'H', . 


/♦MARK FIRST APPROXIMATION 


♦/DERE 370 


OIAG 


= 1,. 


/♦INIT, DIAGONAL COUNT I-ARRAY 


♦/DERE 380 


FMH 


=c,. 


/♦INIT. FLOATING EXTRAPOL -COUNT^/DERE 390 | 






/♦START OF EXTRAPOLATION LOOP 


♦/DERE 400 




DO M = 2 TO 16 BY 2,. 


/♦SINGLE PRECISION VERSION /♦ 


S^/OERE 410 


/* 


DO M = 2 TO 28 BY 2,. 


/♦DOUBLE PRECISION VERSION /♦0^/OERE 420 | 




FMH =FMH+1,. 


/♦UPDATE EXTRAPOLATION COUNT 


♦/DERE 430 




HA =LH/FMH,. 


/♦CALCULATE INTERVAL SIZE 


♦/DERE 440 




FMM =1.. 




DERE 450 




00 MM = 1 TO H,. 


/♦COMP. DISCRETE APPROXIMATION 


♦/DERE 460 




00 I = 1 TO LN.. 




DERE 470 




Yi =Ym,. 




DERE 480 




IF MM= 1 


/♦MODIFY MID-POINT RULE FOR 


♦/DERE 490 




THEN DO., 


/♦FIRST INTERVAL 


♦/DERE 500 




IF CONV='H' 


/♦FOR THE VERY FIRST INTERVAL 


♦/DERE 510 




THEN DO, . 


/♦INIT. VALUES FOR CONV. TEST 


*/DERF 520 




YC(I1=Y!, 




DERE 530 




YMlIl=AeS(YI>,. 


DERE 540 




END,. 




DERE 550 




Zi,FE(I)=.50CGCG00*OYIIl,. 


DERE 560 




FO(I)=0,. 


/♦INIT. SUM OF DERIVATIVES 


♦/DERE 570 




END,. 




DERE 5B0 




ELSE DO,. 




DEPE 590 




ZI =FQU)+DZin,. 


DERE 600 




FO(I)=FEtn,. 


/♦UPDATE AND INTERCHANGE SUM OF^/DERE 610 | 




FEIJ)=ZI,. 


/♦ODD/EVEN SPACED DERIVATIVES 


♦/OERE 620 




END.. 




DERE 630 




Z(n,YI=HA*ZI+YI,. 


/♦CCWP, APPROXIMATE FUNCTION 


♦/DERE 640 




If YMII) LT ABS<Y1 


/♦VALUE FOR LOCAL ARGUMENT LX 


*/DERE 650 




THEN YM(I1=ABS(YII 


, /♦STORE MAX ABSOLUTE VALUE 


♦/DERE 660 




END,. 




OERE 670 




LX =X+FMM*HA.. 


/♦COMP. LOCAL ARGUMENT 


♦/DERE 680 




FMH =fMM+l,. 




OERE 690 




CALL f(LX,Z,OZ),. 


/♦CALCULATE DERIVATIVE 


♦/OERE 700 




If ERROR NE -O- 




OERE 710 




THEN GO TC EXIT.. 


/♦TERMINATE IF ERROR IN FIX.Y) 


♦/DERE 720 




END,. 




OERE 730 




CONV ='C',. 


/♦PRESET CONVERGENCE INDICATOR 


♦/OERE 740 




SOMH =fMH»FKH,, 


/♦SQUARE EXTRAPOLATION 'count 


♦/DERE 750 




HA =HA*C.5,. 




OERE 760 




DO I =1 TO LN,. 


/♦EXTRAPOLATION ON COMPONENTS 


♦/OERE 770 




V =OT(II.. 


/♦SAVE OLD T-VALUE 


♦/DERE 780 




ZI ,CI.DT(I)=Y1IH-HA* 


/♦STORE NEW T-VALUE 


♦/OERE 790 




( . 5cocoooo*oz( n*f o( n*FEi 1 1 1 , . 


OERE 800 




SOMI =SOMH,. 


/♦INIT, VARYING SQUARE NUMBER 


♦/DERE 810 




OSQMI=FHM,. 


/♦INIT. VARYING DECREMENT 


♦/OERE 820 




MM = I , . 




DERE 830 




00 J = 2 TO DIAG,. 




DEPE 840 




MM =MM-*-LN,. 




DERE 850 




DSQMI=DSQMI-2,. 


/♦STEP ODD. INTEGER DECREMENT 


♦/DERE 860 




SQMI =SQMI-DSOMI.. 


/♦COMPUTE NEXT LOWER SQUARE 


♦/DERE 870 




BI =SQMH*V,. 




DERE 880 




CMI =C1*SQMI,. 




DERE 890 




DI =BI-CMI,. 


/♦DENOMINATOR OF CENTRAL ALGOR 


.♦/DERE 900 




U =V,. 




DERE 910 




IF Dl NE 


/♦TEST fOR ZERO DENOMINATOR 


♦/DERE 920 




THEN DO,. 


/♦PERFORM RHOMBUS ALGORITHM 


♦/OERE 930 




01 =(C1-VI/DT,. 


DERE 940 




U =CMI*DI, 




DERE 950 




CI =6I«0I,. 




DERE 960 




END,, 




DERE 970 




V =DT(HM1,. 


/♦SAVE OLD T-VALUE-DIFFERENCE 


♦/DERE 980 




OT(MM)=U,, 


/♦STORE NEW T-VALUE-OIFFERENCE 


♦/OERE 990 




ZI =ZI+U.. 


/♦COMP. NEW T-VALUE 


♦/DEREIOOO 




END,. 




OEREIOIO 




YI =ABS(YC(II-ZH,. 




DERE 1020 




IF YI LT A6S(U) 


/♦SET YI TO 


♦/DERE1030 




THFN YI =ABS(U).. 


/♦HAX(ABS(U).ABS(YCI I)-ZI)> 


♦/0ERE1040 




IF YI GT EPS«YM(n 


/♦COMPONENTWISE CQNVERGENCETEST*/0E«E10 5Cl 




THEN CONV =•!•,. 


/♦NEGATE CONVERGENCE INDICATOP 


♦/DERE106C 




YCl I)=ZI,. 


/♦STORE NEW COMPARISON VALUE 


'/DEBEI070 




END,. 




OEBEICSC 




IF CONV^'C 


/♦GLOBAL CONVERGENCE TEST 


*/DER£lC9C 




THEN GO TO END,. 




DEPFUOC 




ELSE IF DIAG LT 5 


/♦SINGLE PRECISION VERSION /♦S^/OERE 11 LC | 


/* 


ELSE IF DIAG LT 10 


/♦DOUBLE PRECISION VERSION /* 


0^/&EREI120 




THEN DIAG =DIAGt-l,. 


/♦UPDATE DIAGONAL COUNT 


*/OEReil30 



END,. 


0ERfll4P 




/♦END OF EXTRAPOLATION LCOP ♦/DEfiEllSC 


hSTEP=HSTEP+l,. 


/♦UPDATE COUNT OF HALVING STEPS^/OE<'C1160 


LH =LH+n.5,, 


DERE1170 


IF HSTEP LE 20 


/♦MAXIMALLY 20 ITERATIONS WITH */OERE1180 


THEN GO TP HALF., 


/♦REDUCED STEPSIZE ♦/OePE1190 


ELSE GO TO EXIT,. 


/♦TERMINATE IF NO CONVERGENCE ♦/0EPE120C 




/♦END OF ITERATION LOOP */0ERE1210 


END.. 


/♦SUCCESSFUL END OF OPERATION ♦/D£''E122C 


X =X*LH,. 


/♦RETURN ARGUMENT ♦/0eRE1230 


IF DIAG LE 4 


/♦SINGLE PRECISION VERSION /♦S^/OERE 1240 


/♦IF DIAG LE 7 


/♦DOUBLE PRECISION VERSION /♦D^/OE-'E 1250 


THEN LH =LH*LH,, 


/•DOUBLE STEPSIZE ESTIMfiTE */DERF126C 


H =LH,. 


/♦RETURN ADJUSTED STEPSIZE «/0EREl270 


DO I = 1 TO LN,. 


DE^£12eO 


Yd) =YC(I),. 


/♦RETURN EXTRAPOLATED FUNCT I0N-^/DEfiE1290 


END.. 


/♦VALUES ♦/0ERE130C 


EXIT., 


0eRE131C 


END.. 


/♦END OF PROCEDURE OERE ♦/0ERE1320 



Purpose: 

DERE performs one integration step for a system of 
first order ordinary differential equations Y' = 
F(X, Y) with given initial values Y. The stepsize H 
is adjusted for accuracy requirements and speed 
considerations. 

Usage: 

CALL DERE (F, N, H, X, Y, EPS); 

F - ENTRY 

Given procedure for calculation of the 

derivatives. 

This procedure must be supplied by the user. 

Usage: 

CALLF (T, Z, DZ); 

T - BINARY FLOAT [(53)1 

Given independent variable. 

Z - BINARY FLOAT [(53)1 

Given vector of dependent variables. 

DZ - BINARY FLOAT [(53)] 

Resultant vector of derivatives. 



N 



H 



X - 



Y(N) 



EPS 



BINARY FIXED 

Given dimension of the ODE system. 
BINARY FLOAT [(53)1 
Given suggested stepsize for current inte- 
gration step. 
BINARY FLOAT [(53)1 

Given independent variable for initial values. 
Resultant dependent variable for calculated 
values. 

BINARY FLOAT r(53)l 
Given initial values of vector Y for given X. 
Resultant calculated values of Y for 
resultant X. 
BINARY FLOAT 

Given relative tolerance for local error in 
calculated Y-values. 



Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
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following constitute the possible error conditions 
that may be detected: 



Using capital letters for vectors, this is written 
more compactly in vector form: 



ERROR = 'S' means N< or H=0 

ERROR = '1' means no convergence was obtained 

with stepsizes 11/2^ for i = 0, 1, 

. . . , 20 

The last case may occur if stepsize | H | is unreal- 
istically large or if tolerance EPS is too small. 
Suggested values are | H | = 1 and EPS > 10"^ in 
single precision and EPS > lO"-'-'^ in double 
precision. 

If ERROR is changed in the user-supplied pro- 
cedure F(X, Y, DY) to a nonzero value, ERROR 
remains unchanged and DERE returns to the call- 
ing procedure immediately. 

In all cases of a nonzero value of ERROR the 
parameters H,X, Y remain unchanged. The step- 
size H of the integration step gets divided by a 
power of two if accuracy requirements are not 
met otherwise. 

Method: 

DERE uses a rational function for extrapolation and 
is based on the midpoint rule as the underlying dis- 
cretization method. 

For reference see: 

R. Bulirsch and J. Stoer, "Numerical Treatment of 
Ordinary Differential Equations by Extrapolation 
Methods", Numerische Mathematik vol. 8, 1966, 
pp. 1-13. 

Mathematical Background: 
Notation 



Y' = F(x,Y), Y{x^) = Y^ 



Discretization method 



The underlying discretization method proceeds as 
follows: 

Set h = H/2m, x. = x. + ih and let Z. = Z(x .h) 
1 I) 11 

denote approximations to the exact value Y(x.) 
obtained with stepsize h by means of the midpoint 
rule: 



^o = V 2i = 2o^*»^(VV 



z. 



i+1 = Zj.i + 2hF(x., Z.) for i= 1, 2, . . . , 2m-l 



Extrapolation is based on 

^(^''^)=|(^2m-^22m-l"^^<^' ^2m)) 

Under suitable differentiability assumptions the 
asymptotic expansion of T(h,x) proceeds with even 
powers of h: 

T(h,x) = Y(x) + tj(x)h^ + t2(x)h^ + . . . 



Rational extrapolation method 
Rational extrapolation is used to approximate 
T(0,x)=Y(x) 



The problem is to solve the system of differential 
equations 

y' = f^(x.y^, ...,y^) 



y^ = f„(x.y^. ...,y^) 



with given initial values 



Xq, y^ix^) = y^o 



Assume (hj^) to be a strictly decreasing sequence 
of stepsizes tending to zero and let 

(i) , (i) ,.2 (i) , 2k 

(i) Pq +Pi h +... +p^'h 



\^\^ = ^nO 



q«.q«h^....q;V ' 
k=[|],l = p-k 



be the rational function defined by p + 1 nodes: 
rJ"^ (h ) = T(h x) , j = i, i+1, . . . , i+p 

IT J J 

Then the extrapolated values Tp = R^"^' (0) that 
approximate T(0,x) are obtained from the formulas 
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T_f = 



tJ'^ =T(h.,x) 



k k-1 



k-1 



k-1 



h. 



2 r 



i+k/ 



k-1 "^k-1 

T, (i+1) T, (i+1) 
k-1 ^k-2 . 



for k > 1 



-1 



which means that the next lower squares are 
obtained by subtracting decreasing odd integers. 
To avoid repeated calculation of differences, 
the rhombus rule is modified to 

(m-k+1) (m-k) 

^(m-k+l)_ ^k-1 ~ ^k-1 



k-1 



H/2\^ ,^(m-k) / H/2 \ ^^(m-k+l) 



m 



k-1 



m-k 



'k-1 



(m-k) _/ H/2 f (m-k+1) (m-k+1) 
^ "Um-kJ '^-l k-1 



The above formulas connect by a rhombus rule 
the elements 



\-2'^ \-r -^tl' Tf of the tableau 



,(m-k) 



/ H/2 



m 



AT, 



(m-k) ^ (m-k+1) 



k-1 



n 



k-1 



for k = 1, 2, . . . , m 



(T array): 

T,(0) 
-1 

T,(l) 
-1 



,(0) 



,(1) 



p(0) 



,(0) 



starting values are 

^^(i) ^c^i)^T(h.,x) 



and the notation 



AtP= TfV 
k k 



r (i+1) 
k-1 



P (i) _ T, (i) T, (i) 



(P) 



,(P+1) 



T,(P-1) 
1 



implies 



,(0) 
m 



m 

E 

k=0 



AT, 



(m-k) 



Programming Considerations: 
DERE uses the stepsize sequence 



^i-f'\-T'--\-t" 



for extrapolation. 
The square numbers 



/ H/2 
\ m-k 



= (m-k) are 



••) 



generated successively using the identity 



(1-1)^ = 1^ - (21 -1) 



The above formulas are evaluated successively 
for m = 1, 2, . . . . Only one linear array is needed 
for storing the differences ATj^^™"*^) . 

Control of accuracy is done in a natural way: 

Comparing T ,and T^'^^ one increases the subscript 
m-1 m, 

m until this difference and the difference A T are 
small enoi^h, which means less than the user-speci- 
fied tolerance EPS times absolute maximum of the 
approximate fimction values Zj obtained in the current 
interval of length H. This convergence test is ap- 
plied componentwise. 

The sensitivity of the extrapolation process to 
roundoff increases with the order of extrapolation. 
Therefore, the number of columns of the T array 
is limited to c = 5 for the single-precision version 
and to c = 10 for the double-precision version. The 
number of rows is limited to r = 8 and r = 14 re- 
spectively. 
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If k IS not less than the maximum number of 

rtc-c+l) 
columns, the values Tq_]^ are taken as succes- 
sive approximations to the resulting values of Y. 
This continues up to T^^-f"*"-*^) , If no convergence 
is reached at that point, the whole procedure is re- 
peated with H/2 instead of H. DERE provides at 
most 20 iterations, each with half the stepsize of 
the one before. When there is no convergence, 
DERE returns to the calling procedure with 
ERROR='l' and parameters H,X, Y remain un- 
chained. 

Adjustment of the stepsize H is a by-product of 
the above iteration process on length of stepsize. 



If convergence was attained with stepsize h/23 , then 
H/2J is returned as the adjusted stepsize if at least 
4 (7) extrapolation steps have been performed in 
single (double) precision to obtain the result values 
Y(X+H/2i) from input values Y(X), X. 

Otherwise, H/2i~-'^ is returned as adjusted step- 
size in order to speed up calculation time. 

Since the extrapolation method does not neces- 
sarily work with a fixed order, adjustment of step- 
size is uncritical. It does not critically affect 
accuracy, but only speed of computation. 
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t>KUH.JUKc OtR£ PtRFURMS ONE INTEGRATinN STEP FOR A SYSTcr* OF OROINARY DIFFERENTIAL E3UATIQNS (INITTftL VALUE PROBLEM) 



* » 

*PKOCtL)URE DERE * 

« * 

*************** 



*****^l********** 



PRESET 
cRROR=»S» 



***************** 







CI ». 






.* IS * 


Nil 


.* 


SPECIFIED 


..* 


, 


DIMENSION 




* 


.POSITIVE 







01 ». 






.♦ IS •. 


Nil 


.* 


iPECIf lEO 


..» 


, 


iTEPSUE 




* 


. NONZERO . 
*. .* 



♦♦**»tl«»******** 

• PRtSct * 

• tKROR='0'i » 
•INir. COUNT Of » 

• HALVING » 

• « 



♦ *»♦*!; I********** 
»F » 

» CALCULATE • 

• DERIVATIVES FOR* 
»1NIT lAL VALUES * 
♦♦♦*♦*»**♦*♦*♦♦** 



.* WAS ». 
.«utRIVATJVt ». YES 
• . CALCULATION .«... 



HALF 

*****A2 ********** 

* MARK FIRST * 

*APPRnxI MATI ONf ♦ 

...X« INITIALIZE 'X. 

» EXTRAPOLATION * 

» LOOP » 



*****B2 ********** 

* COHP. BASIO * 

* INTERVALSI ZE , * 

* I NIT. * 
•CALCULATION OF * 

* T-VALUE * 
**•*•*••*•*•****• 



«***«C2********** 
« * 

•APPLY MGOIFIEO * 

* MIDPOINT RULE * 
*FOR FIRST STEP * 

* * 
****«« •*«**«*«•«* 



*****02 ********** 

* HITH FIRST * 

* APPROXIMATION * 

* I NI T. * 

* CCNVERGENCE * 

* TE ST * 
***************** 



****«E 2 ********** 

* * 

* INI T. SUM OF * 

* DERIVATIVE * 

* VALUES * 

* * 
***************** 



*****F2********** 
*APPLY MIDPOINT • 

* RULE , * 

* INTERCHANGE 
•DERIVATIVE SUNS* 



**•*«**«*••••«•«* 



*X. 



•••**G7 ***••***** 

• CCMPUTE * 

• APPROXIMATE • 

• VALUE, STORE • 

• MA XI CUM, STEP • 

• ARGUMFNT LX • 
«•***••********•* 



**««*H2 ********** 

*F * 

* CALCULATE • 
♦DERI VATl VES FOR* 

♦ ARGUMENT LX • 
••*•*««********** 



.* WAS *. 

.*OERIVATIVE *. YES 
. CALCULATION .*.... 
*. OK . • 



YES 
.*. 

F3 *. 

.• FULL •. 

.•CYCLE HUH «. 

*. BASIC .• 

• .INTERVAL .* 



•***K I********* 

• END OF • 
•PRJCtDURt UERE *X. 

* * 
*«*••»*•**««*•* 



*****B4*******^^ 
* 

• PRESFT 

X^ CO^VFRGFVICF 

• INDICATOR 
• 
♦•*♦*♦***•♦***»• 



•»***C4********** 

* * 

* SAVE OLD • 
*T-VALUF, STDRF * 

* NEK T-VALUE * 

* • 
******«****«*•«** 



•****D4*^**^^^*** 
« INITIALIZE * 
*CALCULATIOM OF * 

• UEIGHTS IN * 

• RHOMBUS * 

• ALGORITHM • 
•••••••*••••••••• 



*****g4«^ ****«•*« 

* TRANSFORM * 

* OIAGDNAL OF • 

• T-ARRAY • 
•(EXTRAPOLATION)* 

• « 
•••••*•••••••••** 



F* *. 
.* HAS *. 
.*CONVERGENCE*. YF S 
►. TEST BEEN ...... 

•. PASSED .• 



*«***G4«***««««** 



***************** 



*****H4** ******** 

* * 
•HALVE STEPSIZE,* 

* STEP COUNT OF » 
*HALVING (HSTFP)* 

* * 
***•••*•••••••••• 



J4 •. 
.» IS •. 
.•HSTEP LFSS ». VFS 
. OR FCUAL ...... 

*. 20 .• 



•♦•••F 5 *•••*••••• 



•RETURN VALUE OF* 
X^ ARGUMENT • 



•••«*••«*••****** 



•*«**SS •••••*•••« 

• SET UP STEPSIZE^ 

• FOR NEXT • 

• INTEGRATION • 

• STEP • 

• • 
••*•••••••••*•••• 



•••**H 5 ******••• 
• 

• RETURN 

• EXTRAPOLATED 

• VALUES 
• 
•••••••«•••••••• 
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Special Mathematical Functions 



• Subroutine CEL1/CEL2 






CELL. 






CEL 


10 


/«««*«**»«*««««««:««***«*««*« 


*****«*«« 


ft*ft ******************* ****** 


*«***/C£L 


2C 


/* 






*/CEL 


3C 


/* COMPLETE ELLIPTIC INTEGRAL OF 


FI^ST KIND 


*/CEL 


40 


/ft 






*/CEL 


5C 


/*«**««**•,*«»****##*»,**#*„»*««*,** 


«***!****«*«****«*****#**«***«#»«#/(■ pi_ 


60 


PROCEDURE(RES,K),. 






CEL 


70 


DECLARE 






CEL 


80 


ERROR EXTERNAL CHARACTER 1 1 ) , 


/♦EXTERNAL ERROR INDICATOR 


• /CEL 


90 


(RES.K.A.BjBltARr.AARI.GEn.flA 


.AN.W) 


CEL 


100 


BINARY fLOAT, 




/•SINGLE PRECISION VERSION 


/«s*/ceL 


110 


/* BINARY FLCAT(53). 




/•DOUBLE PRECISION VERSION 


/•D*/CEL 


120 


SWITCH CHARACTERdl , 






CtL 


130 


SHITCH='l',. 




/*INIT. CELl ENTRY 


• /CEL 


lAO 


Bl.AN=2.. 






CEL 


15C 


GO TO COM,. 






CEL 


160 


CEL2.. 






CEL 


170 


/*«ft*i|ti|i ««*«««******«««**:([ 4t*i^ 


li****«««**«************«tt*****«*«*«««**«««/CEL 


180 


/* 






*/CEL 


19C 


/* GENERALIZED COMPLETE 


ELLIPTIC 


INTEGRAL OF SECOND KINO 


•/CEL 


200 


/* 






*/CEL 


21C 


/***»««*]»4:««4l|>«:»««*4t ***«***« 


(■ft******* 


********************** rjfV*********/^^^!^ 


220 


ENTRYIRES,K,A,B),. 






CEL 


230 


SWITCH='2',. 




/*INIT. CEL2 ENTRY 


*/CEL 


240 


AA =A, . 






CEL 


250 


AN =A+B,. 






CEL 


26C 


B1,H =6+e,. 






CEL 


27C 


COM.. 




/•START COMMON CALCULATION 


• /CEL 


2 BO 


ERROR='C'.. 




/•PRESET ERROR PARAMETER 


*/CEL 


290 


GEO =I0.5-KI*0.5,. 




/•COMP. GEO " l-K*K 


•/CEL 


300 


GEO =GEO+REO«K,. 






CEL 


310 


IF GEO LE C 




/•TEST FOR SPECIAL CASES OF 


K */CEL 


320 






/•A6S(Kt NOT LESS THAN ONE 


•/CEL 


330 






/•IS INTERPRETED AS IF EQUAL 1 •/CEL 


340 


IF Bl LT C 






CEL 


350 


THEN PES =-RES». 




/•CEL2.. NEGATIVE PARAMETER 


3 */CEL 


360 


IF 81=0 






CEL 


370 


THEN RES =AA,. 




/•CEL3..ZER0 PARAMETER B 


• /CEL 


380 


IF GEO NE 






CEL 


390 


THEN ERRORS' I',. 






CEL 


40C 


GO TO RETURN,. 






CEL 


410 


ENO,. 






CEL 


420 


ARI =2,. 




/•PROCESS OF THE ARITHMETIC 


*/«EL 


430 


ITER.. 




/•GEOMETRIC MEAN 


«/CEL 


440 


GEO =SQRT(GEO».. 






CEL 


450 


GEO =GEO*GeO, . 






CEL 


460 


AARI =ARI,. 






CEL 


47C 


ARI =ARItGEO,. 






CEL 


480 


IF SWITCH='2' 






CEL 


49 C 


THEN 00, . 






CEL 


500 


H =H+AA*GEO,, 






CEL 


510 


W =H*W,. 






CEL 


520 


SI =H/ARI,. 






CEL 


930 


AA *Afl.. 






CEL 


540 


END,. 






CEL 


SSO 


B1,AN=AN«-B1,. 






CEL 


560 


IF GEO/AARI LT ,9999 




/•SINGLE PRECISION VERSION 


/*S»/CEL 


570 


/•IF GEO/AARI LT .999999995 




/•DOUBLE PKECI5I0N VERSION 


/•0*/CEL 


580 


THEN DO,. 






CEL 


590 


GEO =GEO*AARI,. 






CEL 


600 


GO TO ITER,. 






CEL 


610 


END,. 






CEL 


620 


RES =1.37C796326794e97E0*AN/ARI). 




CEL 


630 


RETURN.. 






CEL 


640 


ENO,. 




/•END OF PROCEDURE CEL 


*/CEL 


650 



Purpose: 

CELl computes the complete elliptic integral of the 
first kind: 



■rr/2 



k^sin^t, 5 k < 1 



r dt/^^l 

Usage: 

CALL CELl (RES, K); 

RES - BINARY FLOAT [(53)] 

Resultant value of elliptic integral. 
K - BINARY FLOAT [(53)] 

Given modulus of elliptic integral. 



Purpose: 

CEL2 computes the generalized elliptic integral of 
the second kind: 



7r/2 



/ 



[a+ (b - a)sin t]dt 



0<k<l 



{ 



1 - k sm t 



Usage: 



CALL CEL2 (RES, K, A, B); 



RES - BINARY FLOAT [(53)] 

Resultant value of elliptic integral. 
■ BINARY FLOAT [(53)] 
Given modulus of elliptic integral. 
BINARY FLOAT [(53)] 
Given primary term in numerator. 
BINARY FLOAT [(53)] 
Given secondary term in numerator. 



K 



B 



Remarks: 

If no errors are detected in the processing of data 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error condition 
that may be detected: 

ERROR = '1' means | k| > 1. 

An input value of k with | k | > 1 is treated as if 
it were equal to 1. The value of k, however, re- 
mains unchanged. 

Instead of ± infinity, the procedure returns iio"^^ 
as result values. 

Method: 

Calculation is based on the process of the arithmetic- 
geometric mean, combined with Landen's transfor- 
mation. 

For reference see: 

R. Bulirsch, "Numerical Calculation of Elliptic 
Integrals and Elliptic Functions", Handbook Series 
of Special Functions, Numerische Mathematik. 
vol. 7, 1965, pp. 78-90. 

M. Abramowitz and I. A. Stegun, Handbook of 
Mathematical Functions . Applied Mathematics 
Series 55, National Bureau of Standards, 1964, 
pp. 597-599. 
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Mathematical Background: 
Notation and equivalent definitions 



Let kg denote the complementary modulus defined 
7r/2 



through k^ + k^ = 1, < kg ^ 1. 



cell(k) = K(k) = 



/ 



dt 



y l-k^ sin^t 



00 

/ 



dx 



i ^|'- ' '-' 



(l+X )(l+k^ X ) 



rr/2 2 
,„„ , r a+(b-a)sin t ,^ 
cel2(k;a,b) = / ^ dt 



Vl-k^sin^t 



-I 



a+bx 



dx 



(1+x^) -Ja+x^Xl+k V) 

Important special cases of cel2 are the complete 
elliptic normal integrals: 



7r/2 



K(k) = cel2 (k 



.1.1) = / 



dt 



2 2 
k sin t 



/I 

1 dt 

y ,/ 2 2~2~ 

-ya-t )(l-k t ) 



7r/2 



E(k) = cel2 (k;l.k^) = ^ ^1-k^sin^t 



dt 



1 / l-k^2 



/.T? 



dt 





ff/2 



D(k) =cel2(k;0,l) 



/sin t 
I ~l 



dt 



-yji-k 



2 . 2, 
sm t 



/ 



t^ dt 



/(l^tV^??) 



B(k) = cel2(k 



7r/2 
:;1.0)= I ■ 



2, 
cos t 



dt 



^1- 



2 2 
•k sin t 



1-t 



dt 



'«^'l-kV 



Process of the arithmetic-geometric mean 

Startii^ with the pair of numbers: 

a = 2, g = 2kj. 

the sequences of numbers (a^), (gj^) are generated 
usir^ the definition: 

a=(a +g ,),g=2 fa , • g 7 
n ^ n-1 '^n-l" *n -y n-1 ^n-1 

This iteration process is stopped at the N*'^ step 
when aj, = g-^ to the degree of accuracy of the finite 
arithmetic employed. 

In case cel2 the sequences (Aj), (Bj) are also 
needed. They are defined by means of 



A, = A, 



B^ = 2B 



A = B Ja. 1 + A ,, 
n n-1 n-1 n-1 



B = 2(B T + g , 
n n-1 n-1 



n-1 



Result values obtained are 

N+1 
cell(k) = -^ • ^ 

^ ^N 



IT N+1 

cel2(k.A.B) = f ■ -^^-^ 

^ ^N 
Programming Considerations: 

The equality aj^ = g^ must be interpreted as 

I^N " SnI is l®ss ^^^^ ^N ■ 10"^. where D is 
the number of decimal digits in the mantissa 
of floating-point numbers. 

Since the sequences (2~'^'ajj), (2~'^'gj^) converge 
quadratically to the same limit (arithmetic- 
geometric mean), the above test may be replaced 
by comparing ja^.i -gN-i| against a^-i -lO-I^/ 2, 
thus saving one calculation of the geometric mean. 
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• Subroutine ELI1/ELI2 











El 11.. 




ELI 


10 


/*«*************v************»*********^*********#,**M»*******m****»m/Eti 


20 


/* 




•/ELI 


30 


/• ELLIPTIC INTEGRAL nF FIRST KIND 


•/ELI 


40 


/* 




•/ELI 


50 


/«******««««««« *»***«******«*******«««******«««******«**«*««*****«**«*/gl_ I 


60 


PROCEOUREIRES.ARG.CKOO),. 




ELI 


70 


OECLAFE 




ELI 


80 


EFRD9 EXTERNAL CHARACTEPIl). 


/•EXTERNAL ERROK INDICATOR 


•/ELI 


90 


1kES.ARG,CM00,A,B,AN,API«,PI« 


,ARI,AARI,GEO.SGEO,ANG, 


ELI 


100 


AANG.C.O.P.X.R.AAtAMB) 




ELI 


110 


6INA0Y FLOAT, 


/•SINGLE PRECISION VERSION 


/•S^/ELI 


120 


/* BINARY FLCAT(53)» 


/•DOUBLE PRECISION VERSION 


/•D^/ELI 


130 


ISI BINARY FIXED, 




ELI 


140 


SWITCH CHARACTER 111,. 




ELI 


150 


SWITCH='l'.. 


/•INIT, ELll ENTRY 


•/ELI 


160 


P =1,. 




ELI 


170 


GO TO COM,. 




ELI 


180 


ELI2.. 




ELI 


190 


/****** ********««**«*****#*«****«»***««****»*««*«*»*»*«*«****««**#»*«»/ELI 


200 


/* 




• /ELI 


210 


/* GENERALIZED ELLIPTIC INTEGRAL 


OF SECOND KIND 


•/ELI 


220 


/* 




•/ELI 


230 


/****•*****•*********** ********************«***«**********#**«*#******/EL I 


240 


FNTRY(ReS,ARG,CHOD,A,e),. 




ELI 


250 


SWITCH='2',. 


/•INIT, ELI2 ENTRY 


•/ELI 


260 


D =0.5,. 




ELI 


270 


C =c,. 




ELI 


280 


AA =A,. 




ELI 


290 


R .6,. 




ELI 


300 


AMB =AA-R,. 




ELI 


310 


AN =(AA*R)«.5,. 




ELI 


320 


CON.. 


/•START COMMON CALCULATION 


•/ELI 


330 


ERROR='0',. 


/•SET ERROR PARAMETER 


• /ELI 


340 


X ■ =ARG,. 




ELI 


350 


IF X • C 


/•TEST FOR ZERO ARGUMENT 


•/ELI 


360 


THEN DO,. 




ELI 


370 


CEO =0,. 




ELI 


380 


GO TO RETURN,. 




ELI 


390 


END,. 




ELI 


400 


GEO =A6S(CM0D),. 


/•SET UP GEOIOI 


•/ELI 


410 


IF GEO= 


/•TEST FOR MODUtUS EQUAL ONE •/ELI 


420 


THEN DO,. 




ELI 


430 


AN.ANG'l,. 




ELI 


440 


AANG,GE0=SQRT(1*-X*X»,. 




ELI 


450 


=ABStX),. 




ELI 


460 


GE? .R»LOG(0*GEO),. 




ELI 


470 


GO TO TWO,. 




ELI 


480 


END,. 




ELI 


490 


API •!,. 


/•SET UP ARI 101 


•/ELI 


500 


ANG =A3S(l/XI,. 


/•SET UP ANGIOl 


•/ELI 


510 


PIN -C. 


/•INIT. MULTIPLE OF PI 


•/ELI 


520 


ISI -0,. 




ELI 


530 


LOOP . . 


/•START CENTRAL LOOP 


•/ELI 


540 


APIM .PIM,. 


/•COUNTER 1 STARTS WITH ONE 


• /ELI 


550 


AARl =ARI,. 


/•SAVE ARlU-l) 


•/ELI 


560 


ARI =ARI+GEO,. 


/•CALCULATE ARM II 


• /ELI 


570 


SGEO -AARI*6E0,. 




ELI 


580 


ANG -ANG-SGEO/ANG,. 


/•CALCULATE ANGIII 


• /ELI 


590 


SGEO -SORTISGEO),. 




ELI 


6CC 


IF ANG=0 


/•INCREASE ANGIII IF ZERO 


• /ELI 


610 


THEN ANG "SGE0*1 .E-8,. 


/•SINGLE PRECISION VERSION 


/•S*/ELI 


620 


/*THEN ANG =SGE0*1.E-16,. 


/•DOUBLE PRECISION VERSION 


/•0^/ELI 


630 


IF ANG LT 




ELI 


640 


THEN DO,. 




ELI 


650 


PIN >.3.1415'>2653589793E0*PII' 




ELI 


660 


ISI -ISHl,. 




ELI 


670 


END.. 




ELI 


68C 


IF SlilTCH='2' 




ELI 


690 


THEN DO,. 




ELI 


700 


R =AA*GEO+R,. 


/•CALCULATE BID 


• /ELI 


710 


AA =AN, . 


/•SAVE All) 


•/ELI 


720 


AN =0.5*IAN'»P/ARI),. 


/•CALCULATE A(l*ll 


•/Ell 


730 


AANG =ARI*ARI*ANG*ANG,. 




ELI 


740 


P -0/SORT(AANGI,. 


/•CALCULATE I-TH TERM OF SUM •/ELI 


750 


IF ISI GE 4 




ELI 


760 


THEN ISI =lSI-4,. 




ELI 


770 


IF ISI CE 2 


/•CHANGE SIGN IF ANGLE IS IN •/ELI 


780 


THEN P =-P,. 


/•THIRD OR FOURTH QUADRANT 


• /ELI 


790 


C "C+P,. 




ELI 


SCO 


D =D*IAARI-GE01»0.5/ARI,. 




ELI 


810 


END,. 




ELI 


82C 




/•TEST FOR CONVERGENCE 


• /ELI 


830 


IF AOSIAARI-GEOI GT AARI»lE-« 


/•SINGLE PRECISION VERSION 


/•S^/EL I 


840 


/*IF ABS(AARI-GEC» GT AARI*5E-9 


/•DOUBLE PRECISION VERSION 


/•0^/ELI 


850 


THEN DO,. 




ELI 


860 


GEO =SGEO^SGEO,. 




ELI 


870 


PIM =PIM+APIM,. 




ELI 


880 


ISI -ISI+ISI,. 




ELI 


890 


GO TO LOOP,. 




ELI 


900 


END,. 


/'END OF CENTRAL LOOP 


• /ELI 


910 


GEO ^lATANIARI/ANGIt-PIMI/ARI,. 




ELI 


920 


TWO.. 




ELI 


930 


IF SWITCH='2* 




ELI 


940 


THEN 00,. 




ELI 


950 


C .C»0»ANG/AANG,. 




ELI 


960 


GEO =GEO*AN+C*AMB,. 




ELI 


970 


END,. 




ELI 


980 


IF X LT 




ELI 


990 


THEN GEO «-GeO,. 




ELI 


1000 


RETURN.. 




ELI 


1010 


RES -GEO,. 




ELI 


1020 


END,. 


/•END OF PROCEDURE ELI 


•/ELI 


1030 



eiil (x, ck) 



/ 



dt 



Purpose: 

ELIl computes the incomplete elliptic integral of 
first kind for given values of an argument x and 
complementary modulus ck. 



vt 



ya+t^xi+ck^-t^ 



Usage: 

CALL ELIl (RES, ARG, CMOD); 

RES - 



ARG - 
CMOD - 

Purpose: 



BINARY FLOAT C(53)] 

Resultant value of elliptic integral. 

BINARY FLOAT C(53)] 

Given argument of elliptic integral. 

BINARY FLOAT [(53)] 

Given complementary modulus of 

elliptic integral. 



ELI2 computes the generalized incomplete elliptic 
integral of second kind for given values of an argu- 
ment X, complementary modulus ck, and constants 
a and b. 



eli2 (x, ck; a, b) = / 



(a+bt ) dt 



(1+ 1^) ■\j(l+t^) (1+ck^- 1^) 



Usage: 

CALL ELK (RES, ARG, CMOD, A, B); 

RES - 



ARG 
CMOD 



BINARY FLOAT [(53)] 

Resultant value of elliptic integral. 

BINARY FLOAT [(53)] 

Given argument of elliptic integral. 

BINARY FLOAT [(53)] 

Given complementary modulus of 

elliptic integral. 

BINARY FLOAT [(53)] 

Given primary term in numerator 

(see "Purpose"). 

BINARY FLOAT [(53)] 

Given secondary term in numerator 

(see "Purpose"). 



Remarks: 



Modulus k and complementary modulus ck satisfy the 
relation k + ck^ = 1. Internally, ck is needed for 
calculation rather than k. Therefore, ck is used as 
input parameter. This allows the modulus k to be 
any pure imaginary or real number such that k^ < 1. 
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Method: 

Calculation is based on the process of the arithmetic- 
geometric mean, combined witii descending Landen's 
transformation. 

For reference see: 

R. Bulirsch, "Numerical Calculation of Elliptic 
Integrals and Elliptic Functions", Handbook Series 
of Special Functions, Numerische Mathematik 
vol. 7, 1965, pp. 78-90. 



D(<p,k)=I^^iM4l<^) =eli2(tancp.ck;0,l) 



2 , 
sin t dt 



/^ 



B((p,k) 



k sm t 



E(<p,k) - ck F((p,k) 



eli2(tan (p,ck;l,0) 



Mathematical Background: 
Notation and equivalent definitions: 



elil(x,ck) = 



/ 



dt 



']j(l+t^){l+ck^-t^) 



i 

arctan x 
„„„ . ^/T . 2 , 2. -^ "Vl-k'sin't 



dt 



cos t Vl+ck • tan 



arctan x 

r dt 



eli2(x, ck, a, b)= f 



(a+bt ) dt 



(1+tS '\|(l+t^)(l+ck^-t^) 



arctan x 



/ 



(a +btan t) dt 



i 



2 2 2 

(1+tan t)(l+ck -tan t) 



arctan x 



/ 







(a+(b-a)sin t) dt 



^., 



2 2 
k sin t 



Important special cases are: 

(0 



F(0,k) = elil (ta 



,. f dt 
n <p, ck) = I 

J ^1 -k^ sin\ 



= eli2 (tan cp, ck; 1, 1) 



E((p,k) =eli2(tan<p, ck; 1, ck^) = / V 1 -k^sin^t dt 



^ 

,.// 



ii 



2 
cos t dt 



2 2 
1 -k sin t 



Process of the arithmetic-geometric mean 

Starting with ari =1, geo = |ck [ , the sequences 
(arijj) , (geon) are generated using the recursion 
formulas 



ari , = ari + geo 

n+1 n n 



geo , = 2 -./ari • geo 
^ n+1 V n ^ n 



(1) 
(2) 



This iterative process is stopped at the N step, 
when arij^f = geoN to the degree of accuracy of the 
finite arithmetic employed. 

Descending Landen's transformation 

For the descending Landen transformation the mod- 
ular argle a defined by k = sin a decreases, while 
the amplitudinal angle <p defined by x = tan (f> in- 
creases. 

Successive values of a and <p are combined as fol- 
lows: 



0'j< (3) 



(1+sin a )(l+cos o) = 2 

tan ((f> . -<4 = cos a • tan <p <P,> <P (4) 



Expressed in terms of argument x and comple- 
mentary modulus ck, these equations read 



2 Vck" 
1 1+ck 

^ (l+ck)x 
l-ck- X 



ck. = 



X. 



(5) 
(6) 
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For values of argument and modulus that are con- 
nected by (5) and (6) we have 



Successive application of the descending Landen 
transformation gives 



elil (x.ck) = j;^ elil (x^.ck^) 



(7) 



an. 



elil(x, ck) = -^ elil(x^, ck^) 



eli2 (x,ck;a,b) = j^ eli2(x^,ckj^;aj^,bj) 



(a-b) 



v^ 



where 



(8) 



an ari 

— r- • — — elil(x„,ck„) 
an, ari„ 2* 2' 



Mri^ 
:^^elil(x^_ck^) 



N 



a^ = (a+b)/2 



^ = lTdi<^"^^*"^> 



ari„ 



(9) 
(10) 



eli2(x, ck;a,b) = — :- eli2(x, , ck, ;a, , b.) 

SLVX^ X 111 



u sincp, 
a-b 1 

2' ari. 



The sign determination of 



yi+x^: 



: = sin</3. 



must be done such that cp = arctan x^ is monotonic- 
ally increasii^ {(p >0). 

Final iteration process 

We set: x = 1 x I and ar^„ = 1/x. 
u ' ' 



an 
^^"^(x^.ckgsag.b^) 



a-b /^_^ ^ ^^Vl^ _^^ 

ari, ari, 2 • ari„ 

1 1 z ' 



an. 
1 

i ang. 



(11) 



an 

— :- eli2 (x^ . ck^ : a^^, b^ ^ + SUM 
ari„ N N N N' 

N 



geo. 



ck. 



1 an. 



Furthermore, in case eli2 ve use: 



(12) 



where: 



SUM 



a-b / 1 . 
-r- ( — :- sin cp 
2 Ian 



1 ^"o"^®°0 si*^ ^2 



1 ari ' ari 



A. = a., B. = b.' ari. 
1 111 1 



then: 



. . . + 



1 ^^^o-^^°o 



ari^^ an, 

N 1 



Aq = a. Bq = b 



B. 



A.^, = 1/2 (A. + —!-) 
1+1 1 an. ' 

1 



(13) 



^^'n-2-S^*'n-2 "^'^ 



an 



N-1 



^N-i; 



Since ck = 1 to working accuracy: 



B. . = B. + geo.- A. 
1+1 1*11 



(14) 



an. 



elil (x,^,, ck^J = 0. where tan <P^ = 

N N N N ang. 



N 



N 
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• Subroutine JELF 



a -b 

N N sin (0 . cos c3„ 
o N N 



The final result is 



elil (x, ck) = 



<P 



N 



an 



N 



eli2 (x, ck;a,b) 



N+1 
r— cp-^ + SUM 

_i_fvM 

ari_\ 2 / 



ari,,\ 2 / ''^N 
N 



sin <p- ^ . cos cp 



N 



Degenerate cases of argument and modulus 
X = gives result eli2 = 
ck = gives result eli2 = ^b- In (jxl + Vl+x^) 



(a-b)) 



X sgn X 



aA 



1+x 



Programming Considerations: 

The equality arij^ = geojj must be interpreted as 
' ariN -geoj^l is less than arij^ . 10~I5, where D is 
the number of decimal digits in the mantissa of 
floating-point numbers. 

Since the sequences (ariji . 2"*^), (geOjj. 2~^) 
converge quadratically to the same limit (arith- 
metic-geometric mean) , the above test may be re- 
placed by comparing 

|arijg_]^ - geoj^.^jagainst ari^-i . 10"D/2j thus 
saving one calculation of the geometric mean. 



JELF.. 








JELF 


IC 




«*i|i«****«*«****«***«*«» «*«****** 


♦♦/JELF 


20 


/* 








•/JELF 


30 


/* JACOeiAN ELLIPTIC FUNCTIONS 


SN, CN, DN 




•/JELF 


40 


/• 








♦/JELF 


5C 


/*:*««*******»**«*s*«******«««*****<^a 


*«*i(.«H***»*******«*****«**»*««««»*/JcLF 


6C 


PROCEDURE (SN,CN,DN,X,SCK) 


. 






JELF 


7C 


DECLARE 








JELF 


80 


ERROR EXTERNAL CHARACTERU). 


/♦EXTERNAL ERROR INDICATOR 




•/JELf 


90 


(SNtCN.DN,X,SCK,CM,Y 


LSN, LCN 


,LON,KtARlt 12).GE0U2I.A,B,C. 


0) 


JELF 


100 


BINARY FLOAT, 




/♦SINGLE PRECISION VERSION 


/* 


S*-/JcLF 


lie 


/* BlNfiRY FLOAT(53). 




/♦DOUBLE PRECISION VERSION 


/*D^/JELF 


120 


U.J> BINARY FIXED.. 








JELF 


130 


ERROR='0',. 








JELF 


KC 


CM =SCK,. 








JELF 


15C 


Y =X,. 








JELF. 


160 


IF CM= 




/•TEST VALUE OF MODULUS 




/JELF 


170 


THEN DO, . 




/♦DEGENERATE CASE SCK = C 




♦/JELF 


180 


LCN,LDN=1/CQSH(V).. 








JELF 


190 


LSN =TANH(YI,. 








JELF 


2C0 


GO TO RETURN,. 








JELF 


210 


ENO,. 








JELF 


220 


IF CM LT 








JELF 


230 


THEN DO.. 




/♦MODULUS TRANSFORMATION 




♦/JELF 


240 


K =(0,5-CM)+0.5,. 








JELF 


250 


CM *-CM/K,. 








JELF 


260 


K =SORT(K),. 








JELF 


270 


Y =K*Yr. 








JELF 


280 


END,. 








JELF 


290 


C,LDN=I,. 




/♦PROCESS OF THE ARITHMETIC 


— 


•/JELF 


300 


DO 1=1 TO 12,. 




/♦GEOMETRIC MEAN 




•/JELF 


310 


ARm),LCN=C,. 








JELF 


320 


GeO( H,CM=SQRTtCM),. 








JELF 


330 


C =.5*ILCN+CH|,. 








JELF 


340 


IF ABSILCN-CMJ LE If 


-4*ICN 


/♦SINGLE PRECISION VERSION 


/* 


S^/JELF 


350 


/* IF A9S(LCN-CM) LE 5E 


-9*LCN 


/♦DOUBLE PRECISION VERSION 


/♦ 


D^/JELF 


360 


THEN GO TO CONV.. 








JELF 


370 


CM =CM»LCN,. 








JELF 


380 


END,. 








JELF 


390 


CONV.. 




/♦INIT. INVERSE GAUSS- 




♦/JELF 


400 


Y =Y*G,. 




/♦TRANSFORHATION 




♦/JELF 


41C 


LSN,0=SINIY).. 








JELF 


420 


LCN =COStY),. 








JELF 


430 


IF LSN= 








JELF 


440 


THEN GO TO TEST.. 








JELF 


450 


A =LCN/LSN,. 








JELF 


460 


C =A*C,. 








JELF 


470 


DO J =1 TO 1 BY -1,. 




/♦INVERSE GAUSS-TRANSFORMATION 


•/JELF 


48C 


B =ARItJ).. 








JELF 


49C 


A =A«C,. 








JELF 


500 


C =LON*C,. 








JELF 


510 


LDN =IGEC(J)*A)/tB*A),. 






JELF 


520 


A =C/B,. 








JELF 


530 


END,. 








JELF 


540 


LSN =SORT(l/tltC»C)),. 








JELF 


550 


IF D LT C 








JELF 


560 


THEN LSN =-LSN,. 








JELF 


570 


LCN =C*LSN,. 








JELF 


580 


TEST.. 




/♦INVERSE MODULUS-TRANSFORHAT 


•/JELF 


590 


IF SCK LT C 








JELF 


600 


THEN DO,. 








JELF 


610 


A =LDN,. 








JELF 


620 


LON =LCN,. 








JELF 


630 


LCN =fl,. 








JELF 


640 


LSN =LSN/K.. 








JELF 


650 


END,. 








JELF 


660 


RETURN.. 




/♦RETURN RESULT VALUES 




♦/JELF 


670 


SN =LSN.. 








JELF 


680 


CN =LCN., 








JELF 


690 


ON =LDN,. 








JELF 


700 


END,. 




/♦END OF PROCEDURE JELF 




♦/JELF 


710 



Purpose: 

JELF calculates the three Jacobian elliptic functions 
SN, CN, DN. 

Usage: 

CALL JELF (SN,CN,DN,X,SCK); 

SN - BINARY FLOAT [(53)] 

Resultant value of the sine of the amplitude. 

CN - BINARY FLOAT [(53)] 

Resultant value of the cosine of the ampli- 
tude. 

DN - BINARY FLOAT [(53)] 

Resultant value of the delta of the amplitude. 

X - BINARY FLOAT [(53)] 

Given argument of Jacobian elliptic functions. 

SCK - BINARY FLOAT [(53)] 

Given square of complementary modulus. 
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Remarks: 

The values of SN, CN, DN are frequently needed 
together. Therefore, procedure JELF computes all 
three of them. This is no disadvantage , since com- 
putation of all three result values is no more compli- 
cated than computation of any one of them. The 
value SCK is chosen as an input parameter in order 
to allow for complex values of ck (k is not restricted 
tok2<l). 

Method: 

The calculation is based on the process of the 
arithmetic-geometric mean together with Gauss' 
transformation. 

For reference see: 

R. Bulirsch, "Numerical Calculation of Elliptic 
Integrals and Elliptic Functions", Numerische 
Mathematik, vol. 7, 1965, pp, 78-90. 

Mathematical Background: 

Notation and definition 

The value k is the modulus , ck is the complementary 
modulus, and sck is the square of the comple- 
mentary modulus. 



2 2 

sck = ck = 1-k -"^ < sck < <» 



The three Jacobian elliptic functions arise as 
inverse functions of elliptic integrals. 
Set: 



<P 



x = F((p,k) = 







dt 



2 2 
•k sin t 



(1) 



Then (p is called the amplitude of x. 

<p= am (x,k) 
Jacobi's functions are defined through 

sn(x,k) = sin (p = sin am (x,k) (2) 

(3) 
(4) 



cn(x,k) = cos (f) = cos am (x,k) 
dn(x,k) = vl-k sin o 



The degenerate case sck = (that is, |k| = 1) must 
be treated separately: 

sn(x, 1) = tanh x. 

cn(x, 1) = dn (x, 1) = 1/cosh x 

Jacobi's modulus transformation, applied to nega- 
tive values of sck, gives 

sn(x,k) = 1/k . sn (kx,l/k) (5) 

cn(x,k) = dn(kx, l/k) (6) 

dn(x,k) = cn(kx,l/k) (7) 

Process of the arithmetic- geome tric mean 

Starting with ari, = 1 , geo. = -y/sck, the sequences 
(ari ), (geo ) are generated using the recursion 
formulas 



(8) 



§%+l = V^ri^ . geo^ 



(9) 



Numerical experience shows that eleven iterations 
are sufficient to obtatn convergence, to full working 
accuracy, for all values of the squared comple- 
mentary modulus that may be represented in floating 
point. The iteration process is stopped at the N**^ 
step, as soon as ^^^ijr+i'S^Ojr+l ^^ negligibly small. 



Gauss transformation 
Gauss' transformation gives 
F(cp^,kj) = (l + k)F((p,k) 



(10) 



for values of modulus and amplitudinal angle that are 
combined through 

2VF 



k, = 



1 1 + K 



and 



sin <f> = 



(1+k) sin (p 



(11) 



(12) 



1+k sin cp 
Inversion of this transformation results in 

F((p,k) = (l+kj^)F((p^,k^) (10') 
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where: 



sin (p = ■ 



(1+kj^) sin (pj 



(11-) 



1+k sin <p^ 



and 



k = 



^^fh 



l+K 



(12-) 



Inversion of F(<p,k) 

Successive application of transformation (10'), with 



geo. 



ok. = 



i+1 



1 an 



(13) 



i+1 



leads to F((p,k) = (l+k^) . . . (1+k^) F{ip^^ k^) 



1-ck. 



Equation (12') implies that k 



i+1 1+ck. 



and that 



an 



1 + k.., = 



i+1 



i+1 ari 



i+2 



If k = 0, it follows that 



an. 





X 


= F((p,k) 


ari 
N+1 






F((P^k 


or 


•Pn 


= ^"n+i 


. X 


Back transformation of cp 



<p> 



(14) 



To obtain the Jacobian elliptic functions , the inverse 
transformation must be performed on (p . Equation 
(11') implies 



From (11') and (12') it follows that 



/, , 2 .2 
-v/l-k sm <p = 
V n ^n 



1-k ,, sin cp ,, 
n+1 ^n+1 

2 
1+k ^, sin cp ^, 
n+1 n+1 



cot <p ^, ^ 1-k ^ , 
n+1 + n+1 

cot (p ^, + 1+k , , 
n+1 n+1 



(16) 



geo , + ari „ • cot , 
^ n+1 n+2 ^n+1 

2 
an , , + an , „ • cot cp , 
n+1 n+2 ^n+1 



1-k ,, geo ,, 

n+1 , n+1 

since -— ; = ck = — : 

1+k _ n ari , 

n+1 n+1 

and 



an 



1+k 



n+1 



h+1 ari 



n+2 



Final iteration scheme 



Setting CN+2. = arij^+i • cot <pN, with d-^+i = 1, the 
following iteration is performed for n = N, N-1, 
. . . , 1: 



'^n = Vl • ^n+1 



c , ,ari „ + geo , 
, ^ n+1/ n+2 ^ n+1 

n 2 . 

c , ,an „ + an , 
n+1/ n+2 n+1 



The final result is 



c = cot (p 



A /, ,2 .2 

d = -\/l-k sin <p 



and therefore: 



cotcp =-^1^ cot<pj -^1 - k^ sin <p^ 



sn(x,k) = 



Vi+«? 



: = sin cp 



or generally 



cn(x,k) = sn«c = cos <p 



ari cot cp , = ari , c 
n n-1 n+1 



^15) , 

V2 2 I 2 2 

1-k^ sin <p^ dn(x,k) =dj^ = -^1-k sin (p 
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• Subroutine LGAM 



Method: 



LGIM., 








LGAM 10 


/t«*it****#-tifi>t**.***#*tt**^*t'****»=***<t<t:***«*ft:***m****rfttt******-**** 


**/LGAH 20 


/* 








VLGAM 30 


/* 


COMPUTES THE DOUBLE PRECISION 


NATURAL LOGARITHM OF THE 


GAMMA 


*/LGAH 40 


/* 


FUNCTION OF A GIVEN DOUBLE PRECISION ARGUMENT. 




*/LGAM 50 


/* 








*/LGAM 60 


/***«♦****<,(.***#« V*t *****,*,:»#*, ft^»,ij 




***«**#/LGAM 70 1 


PROCEDURE ( XXtDLNGl,, 






LGAM 80 


DECLARE 






LGAM 90 




(XX, ZZ, TERM, HZ2, DING) FLOAT BINARY (53), 




LGAM 100 




E^^GR EXTERNAL CHARACTER (1), 






LGAM 110 


ERROR=«0' ,, 






LGAM 120 


ZZ 


= XX, . 






LGAM 130 


IF XX LE I.EIO 






LGAM 140 


THEN 


IF XX LE l.E-09 


/* XX IS NEAR OR NEGATIVE 


*/LGAM 150 




THEN 00,. 


/* SET ERROR INDICATOR 




*/LGAM 160 




EfiPDR='2',. 






LGAM 170 




DLNG =-l.E75,. 






LGAM 180 




GO TO S2G,. 






LGAM 190 




END,. 






LGAM 200 




ELSE DO,. 


/• XX > AND < OR = TO 1 


.E*10 


*/LGAM 210 




TERM =I.EO,. 






LGAM 220 


SIO.. 








LGAM 230 




IF ZZ LE 18. EO 


/* 2Z < OR = 18 




*/LGAM 240 




THEN DO.. 


/* TRANSLATE ARGUMENT 




*/LGAM 250 




TERM =TEPM*ZZ,. 






LGAM 260 




ZZ =ZZtl.EO,. 






LGAM 270 




GO TO SIO,. 






LGAM 280 




END,. 






LGAM 290 




ELSE DO,. 


/• CALC. EQUATION 1 




*/LGfiM 300 




RZ2 =1.E0/ZZ**2,. 






LGAM 310 




DLNG =(ZZ-C.5EC)*LOG(ZZ)-ZZ+0.918938533204672EO 


LGAM 320 




-L0G(TERM)«-(1 


.EO/ZZ I *(. 83333333333333 3E 


-01 


LGAM 330 




-(RZ2*1. 27777 T7 77777777E-02+{RZ2» 




LGAM 340 




1. 79365079365 


C793E-03-IRZ2* 




LGAM 350 




(.595238C95233C95E-03)» ))))!,. 




LGAM 360 




GO TO S2C,. 






LGAM 370 




END,. 






LGAM 380 




END,. 






LGAM 390 


ELSE 


IF XX LT 1.E7C 


/* XX > l.E*10 AND < 1.E+7C 


*/LGAM 400 




THEN 00,. 






LGAM 410 




DLNG =ZZ*(LOGUZ)-I.E0), 


/* CALC. EQUATION 2 




*/LGAM 420 




GO TO S2C,. 






LGAM 430 




END,. 






LGAM 440 




ELSE DO,. 


/* XX > OR = l.E+70 




•/LGAM 450 




ERR0R=*1 ■ ,. 


/* SET ERROR INDICATOR 




*/LGAM 460 




DLNG =I.E75,. 






LGAM 470 




END,. 






LGAM 480 


S20.. 








LGAM 490 


RETUPN,. 






LGAM 500 


END, 




/" END OF PROCEDURE LGAM 




*/LGAM 510 



Purpose: 

LGAM computes the double -precision natural loga- 
rithm of the gamma function of a given double- 
precision argument. 

Usage: 

CALL LGAM (XX, DLNG); 



XX 



DLNG 



Remarks : 



BINARY FLOAT (53) 
Given double-precision argument for the 
log gamma function. 
BINARY FLOAT (53) 
Resultant double-precision variable con- 
taining the log gamma function. 



For reference see: 

M. Abramowitz and I. A. 
Mathematical Functions, 



Stegun, Handbook of 
U. S. Department of 



Commerce, National Bureau of Standards Applied 
Mathematics Series, 1966, equation 6. 1. 4. 

Mathematical Backgrovmd: 

This subroutine computes the double -precis ion 
natural logarithm of the gamma function of a given 
double -precis ion argument, xx, where 10~^< xx < 10 
The Euler-McLaurin expansion, to the seventh de 
rivative term, is used. For xx>0: 



log r (xx) = (xx - 1/2) log XX 

+ 1/2 log 2 TT - XX + 1/(12 XX) - 1/360 xx^ 



70 



+ 1/1260 xx^ = 1/1680 xx'^ 



(1) 



This expression is very accurate for xx>18. If 
XX s 18, XX is replaced by z = k + xx, where k is an 
integer such that z > 18. Log T (z) is then evaluated 
by (1), and log xx + log (xx + 1) + . . . + log (xx + k - 1) 
is subtracted to obtain the desired result. 

If XX is between 10^*^ and lo''^^, terms of lowest 
order in (1) are neglected, and log T (xx) is computed 

as: 



log r (xx) = XX (log(xx) - 1) 



(2) 



Subroutine LGAM is available in a double-precision 
format only. If the single-precision value of the log 
gamma function of a given single-precision argu- 
ment is desired, subroutine LGAM should be changed 
to single precision. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 



ERR0R=1 - If XX is greater than or equal to 10 
If this condition exists, the value of 
DLNG is set to 1. E75. 

ERROR=2 - If XX is less than or equal to 10~9, 
DLNG is set to -1. E75. 



,70 



180 Mathematics — Special Functions 



STATISTICS 



Usage: 



Data Screening and Analysis 
• Subroutine TALY 



TALY.. 




''ALY 10 


/*« 


**«««««« «««* *>K««iti A «**«9:#««««*«««tX-A» ***««««*«*«*«*»««« ««<r ««*«**** 


**/raLY 20 


/« 






«/TALY 30 


/« 




10 CALCULATE TOTAL, MEAN, STANDARD DEVIATION, MINIMUM, 


*/TALY AO 


/* 




MAXIMUM FOF. EACH VARIABLE IN A SET (OR A SUBSET) OF OBSER- 


*/TALY 50 


/* 




VATIONS. 


*/TALY 60 


/* 






*/TALY 70 


/*******««««««:(•»»: «#«««:f««:«:**C*««««««>|>«i<: «**«««»*««««****« >K«4A*«*>^>K««» 


•"/TftLY 8C 




PROCEDURE lA,S.TOTAL,AVER,SO,VMIN,VMflX,NO.NV) «. 


TALY 9C 




DECLARE 


TALY 100 






ESPPR EXTEFNAL CHARACTER tl). 


TftLY 110 






<I .J.K.NO.NV) 


TALY 120 






FIXFO Blt^ARY, 


TALY 130 






(A( *,*),$(*), TOTAL (*). AVER {*),SDI*J,VMIN(*l,VMAX(*),SCNT,0) 


TALY 1«C 






FLOAT BINARY,. 


TALY 150 


/* 






*/TALY 160 


/* 




CLEAR OUTPUT VECTORS ANO INITIALIZE VMIN.VMAX. 


«/TALY 170 


/* 






*/TALY 160 




ERROB='0',. 


TALY 190 






DO 1 = 1 TO NV, . 


TALY 200 






TQTAL(I) =0,. 


TALY 210 






AVER(I) =0,. 


TALY 220 






SD(I) =0,. 


TALY 230 






VMIN(I) =0,. 


TALY 240 






VMAXU) =0,. 


TALY 250 






END,. 


TALY 260 




IF NV LE C OR NO LE C /* NUMBER OF OBSERVATIONS OR 


*/TALY 270 




THEN 


00,. /* THE NUMBER OF VARIABLES LESS»/TALY 280 | 






ERRnR='l',. /* THAN OR EQUAL TO ZERO. 


*/TALY 290 






GO TO S5C,. 


TflLY 3C0 






END,. 


TALY 310 






DO J = 1 TO NV.. 


TALY 32C 






TOTAHJ) = 0,0,. 


TALY 330 






AVER(J)=0,.C,. 


TALY 34C 






SD(J)=O.C,. 


TALY 350 






ENOt. 


TALY 360 






00 J = 1 TO NO,. 


TALY 370 






IF SIJ) NE O.C 


TALY 380 






THEN DO,. 


TALY 390 






K =J,. 


TALY 400 






GO TO SIC. 


TALY 410 






END, . 


TALY 420 






END,. 


TALY 430 


/* 






*/TALY 44C 


/* 




NO OBSERVATIONS ARE IN SUBSET 


*/TALV 45C 


/* 






*/TALY 460 




ERR0R='2',. 


TALY 470 




GO TO S50,, 


TALY 480 


SIC 






TALV 490 






DO J = 1 TO NV,. 


TALY 5C0 






VMIN(J)=A(K,J),. 


TALY 510 






VMAX(J»=VMINtJ),. 


TALV 520 






END,. 


TALY 530 




SCNT 


-O.C, /* TEST SUBSET VECTOR 


*/TALY 540 






00 I = K TO NO,. 


TALY 550 






IF Sin NE 0.0 


TALY 560 






THEN 00,. 


TALY 570 






SCNT =SCNT+l.Ct. 


TALY 580 






DO J = 1 TO NV., /* CALCULATE TOTAL .MAX ,MIN 


*/TALY 590 






rOTALlJ)=TOTAL(J)*All,J).. 


TALY 600 






IF A(I,J) LT VMINIJ) 


TALY 610 






THEN VMINIJ)=A(I.J),. 


TALY 620 






IF AU,J) 6T VMAX(J) 


TALV 630 






THEN VHAX(J)=A(I.J).. 


TALY 640 






SO(J)=SD(J»+A(I,J)*A(I,J).. 


TALY 650 






END,. 


TALY 660 






ENO.. 


TALY 670 






END,. 


TALY 680 


/* 






*/TALY 690 


/* 




CALCULATE MEANS ANO STANDARD DEVIATIONS. 


»/TALY 700 


/* 






*/TALY 710 






DO J = 1 TO NVt. 


TALY 720 






AVER{J)=TOTAHJ)/SCNT,. /* COMPUTE MEAN 


«/TALY 730 






IF SCNT= 1.0 


TALY 740 






THEN DO,. 


TALV 750 






ERR0R='3S. /* SAMPLE SIZE IN SUBSET = 1 


*/TALY 76C 






SO(J)=C.O.. 


TALY 770 






GO TO S2C,. 


TALY 780 






END.. 


TALY 790 






ELSE DO,. 


TALY 800 






= SOU )-T0TALIJ)*T0T ALU) /SCNT.. 


TALY 81C 






IF D LE 0.0 


TALV 820 






THEN DO,. 


TALY 830 






ERRGR='A'.. /* VARIANCE = 0.0 


*/TALY 840 






SD(J)==C.O,. 


TALY 850 






GO TO S20.. 


TALY 860 






END,. 


TALY 870 






ELSE S0U> = SQPT(D/(SCNT-1.0)),. 


TALY 880 






END.. 


TALY 890 


SZi 


• t 




TALY 900 






END.. 


TALY 910 


S50.. 




TALY 920 




RETURN,. 


TALY 930 




ENOt 


/*END OF PROCEDURE TALY 


*/T6LY 940 



Purpose: 

TALY calculates total, mean, standard deviation, 
minimum, maximum for each variable in a set (or 
a subset) of observations. 



CALL TALY (A, S, TOTAL, AVER, SD, VMIN, 
VMAX, NO, NV); 

Description of parameters: 

A(NO, NV) - BINARY FLOAT 

Given observation matrix. 

S(NO) - BINARY FLOAT 

Given vector indicating subset of 
A. Only those observations with 
a nonzero S(J) are considered. 

TOTAL(NV) - BINARY FLOAT 

Resultant vector of totals. 

AVER(NV) - BINARY FLOAT 

Resultant vector of means. 

SD(NV) - BINARY FLOAT 

Resultant vector of standard devia- 
tions. 

V]VnN(NV) - BINARY FLOAT 

Resultant vector of minima. 

VMAX(NV) - BINARY FLOAT 

Resultant vector of maxima. 

NO - BINARY FIXED 

Given parameter equal to the nvim- 
ber of observations. 

NV - BINARY FIXED 

Given parameter equal to the nxmiber 
of variables. 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 



ERR0R=1 

ERROR=2 
ERROR=3 
ERROR=4 

Method: 



number of observations or the number 
of variables less than or equal to zero, 
no observations in subset vector, 
sample size in subset equal to one. 
variance equal to zero. 



All observations corresponding to a nonzero element 
in the S vector are analyzed for each variable in 
matrix A. Totals are accumulated and minimum and 
maximimi values are found. Following this, means 
and standard deviations are calculated. The divisor 
for standard deviations is one less than the number 
of observations used. 
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• Subroutine BOUN 



t:***f**** **************** 



m****************, 



TO SELECT FROM fi SET (OR A SUBSET) OF OBSERVATIONS THE 
NUMBER OF OBSERVATIONS UNDER, BETWEEN AND OVER TMO GIVEN 
BOUNDS FOR EACH VARIABLE. 

*«*«*«»*****#*«»•«*»****♦•*«**••*«*****•♦***♦*♦♦**•♦********•****' 
PROCEDURE ( A, SiBLO.BHl, UNDER, 8ETW, OVER, NOtNV),. 
DECLARE 

1 1, J.NCNVI 

FIXED BINARY, 

ERROR EXTERNAL CHARACTERI 1 ) , 

(A(*,*»,S1*),BLQI*),6HI («l.UNDERt*»,BeTH{*).OVERt*>) 

FLOAT BINARY,. 



ERROR='C',. 

IF NV LE C OR NO LE 

THEN DO,. 

ERRORS' i* ,, 

GO TO FIN,. 

END,. 

00 J = 1 TO NV,. 

UNDERCJ>=0.0,, 

BETH(J)=0.0,. 

OVERIJI'C.O,. 

END,. 

DO J = 1 TO NV,. 

IF BHKJ) LE SlOUl 

THEN DO,. 

ERR0R='2', . 

GO TO FIN,. 

END*. 
END, . 

DD I = 1 TO NO,. 
IF Stn NE 0.0 
THEN DO,. 



/* NUMBER OF OBSERVATIONS OR 
/* THE NUMBER OF VARIABLES LE 
/* THAN OR EQUAL TO ZERO. 



■■ CLEAR OUTPUT VECTORS 



/* LOWER BOUND GREATER THAN 
/* UPPER BOUND. 



/* TEST SUBSET VECTOR 



COMPARE OBSERVATIONS WITH BOUNDS 

OC J = I TO NV,. 
IF &(I,J) GE BLO(J) 
THEN DO,. 

IF All, J) LE BHI(J) 

THEN 8ETW(J)=BETH(JH-l.O,. 

ELSE OVER(J)=OVER(JI*l.O,. 

END,. 
ELSE UNDERtJ)=UNOEP(J)+l.O,. 
END,. 



RETURN,. 
END,. 



/*END OF PROCEDURE BOUN 



BOUN 10 

/BOUN 20 

*/BOUN 30 

*/BOUN 40 

*/BOUN 50 

•/BOUN 60 

•/BOUN 70 

•••/BOUN 80 

BOUN 90 

BOUN 100 

BOUN 110 

BOUN 120 

BOUN 130 

BOUN 140 

BOON 150 

•/BOUN 160 

BOUN 170 

•/BOUN 180 

SS^/BOUN 190 

•/BOUN 200 

BOUN 210 

BOUN 220 

•/BOUN 230 

BOUN 240 

BOUN 250 

BOUN 260 

BOUN 270 

BOUN 260 

*/BOUN 290 

*/BQUN 300 

BOUN 310 

BOUN 320 

BOUN 330 

80UN 340 

BOUN 350 

•/BOUN 360 

BOUN 370 

•/BOUN 380 

•/BOON 390 

♦/BOUN 400 

BOUN 410 

BOUN 420 

BOUN 430 

BOUN 440 

BOUN 450 

BOUN 460 

BOUN 470 

BOUN 480 

BOUN 490 

80UN 500 

BOUN 510 

BOUN 520 

BOUN 530 

•/BOUN 540 



BETW(NV) 

OVER(NV) 

NO 

NV 

Remarks: 



BINARY FLOAT 

Resultant vector indicating, for each 
variable, number of observations 
equal to or between lower and upper 
bounds. 

BINARY FLOAT 
Resultant vector indicating, for 
each variable, nxmiber of observa- 
tions over upper bounds. 
BINARY FIXED 
Given number of observations. 
BINARY FIXED 

Given number of variables for each 
observation. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR=l - number of observations or number of 
variables less than or equal to zero. 
ERROR=2 - lower bound greater than upper boimd. 

Method: 



Purpose: 

BOUN selects from a set (or a subset) of observa- 
tions the number of observations imder, between, 
and over two given bounds for each variable. 

Usage: 

CALL BOUN (A, S, BLO, BHI, UNDER, BETW, 
OVER, NO, NV); 

Description of parameters: 

A(NO,NV) - BINARY FLOAT 

Given observation matrix. 

S(NO) - BINARY FLOAT 

Given vector indicating subset of A. 
Only those observations with a non- 
zero S(J) are considered. 

BLO(NV) - BINARY FLOAT 

Given vector of lower bounds on all 
variables. 

BHI(NV) - BINARY FLOAT 

Given vector of upper boimds on all 
variables. 

UNDER(NV) - BINARY FLOAT 

Resultant vector indicating, for each 
variable, number of observations 
imder lower bounds. 



Each row (observation) of the matrix A with corre- 
sponding nonzero element in S vector is tested. Ob- 
servations are compared with specified lower and 
upper variable bounds and counts are kept in vectors 
UNDER, BETW and OVER. 
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• Subroutine ABST 



Method: 



ABST.. 








ABST 


10 


/*****************************»*m***»***»********»***t************mm*9/ABSl 


20 


/« 








•/ABST 


30 


/» to lESr MISSING OR ZERO 


VALUES FOR OBSERVATION MATRIX A. 




•/ABST 


40 


/• 








•/ABST 


50 




•••/ABST 


60 


PROCEDURE (A»SfNO,NVI.. 








ABST 


70 


DECLARE 








ABST 


80 


<I,J,N0,NV1 








ABST 


90 


FIXED BINARV. 








ABST 


100 


ERROR EXTERNAL CHARACTERIIlt 






ABST 


110 


(A(*,*l,S(*n fLOAT BINARY,. 






ABST 


120 


/* 








•/ABST 


130 


ERROR. •0',. 








ABST 


1«0 


IF NV LE OR NO LE 




/• NUMBER OF OBSERVATIONS 


OR 


•/ABST 


150 


THEN DO,. 




/♦ THE NUMBER OF VARIABLES 


LESS«/A8ST 


160 


ERROR='l',. 




/* THAN OR EQUAL TO ZERO. 




•/ABST 


170 


GO TO FIN,. 








ABST 


180 


END,. 








ABST 


190 


DO I = I TO NO,. 








ABST 


200 










ABST 


210 










ABST 


220 


THEN 00,. 








ABST 


230 


Sill =0.0,. 








ABST 


240 


GO TO SIO,. 








ABST 


250 


END,. 








ABST 


260 


END,. 








ABST 


270 


Sin -i.o,. 








ABST 


280 










ABST 


290 










ABST 


300 


FIN.. 








ABST 


310 


RETURN,. 








ABST 


320, 


END,. 




/*END OF PROCEDURE ABST 




•/ABST 


330 



Purpose: 

ABST tests for missing or zero elements in obser- 
vation matrix A. 



A test is made on the I-th row (observation) of the 
matrix A, 1 = 1, . . . , NO. If there is not a missing 
or zero value, 1 is placed in SQ). If at least one 
variable has a value missing or zero, is placed in 

sp). 



Usage: 

CALL ABST (A, S, NO, NV); 

Description of parameters: 



A(NO, NV) 
S(NO) 



NO 

NV 



BINARY FLOAT 

Given observation matrix. 

BINARY FLOAT 

Resultant vector indicating one of the 

following codes for each observation: 

1 There is not a missing or zero value. 

At least one variable has a value 

missing or zero. 
BINARY FIXED 

Given number of observations. 

BINARY FIXED 

Given number of variables for each 

observation. 



Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitutes the possible error condition 
that may be detected: 

ERR0R=1 - number of observations or number of 
variables less than or equal to zero. 
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Subroutine SBST 



NUMBER OF OBSEPVAT IONS, 
VARIABLES, OR CONDITION: 
LESS THAN OR EQUAL TO I 



S8ST,. 

/* 

/* TO DERIVE A SUBSET VECTOR INDICATING WHICH OBSERVATION^ 
/* A SFT HAVE SATISFIED CERTAIN CCNOITIONS. 

/*•«»********»*♦**##**»****#, ,,^,^,^^^^^.^^„,^^^^^^^^^^^^^^^^^^ 
PROCEDURE (A,C,R.B,S,NO,NV,NC) ,. 
DECLARE 

e ENTRY, 

ERROR EXTERNAL CHARACTER ( 1 ) , 

(I,ICOL,IGO,J,NC,N0) 

FIXED BINARY, 

(A1*,*|,C1*,*),R(*J,SI*),0.TF» 

BINARY FLOAT, 

T16) LABEL,. 
/* 

ERROR='0' ,. 

DO 1=1 TO NO, . 

Sd) =0,. 

END. . 
IF NO LE OP NV LE OR NC LE 
THEN DO, . 

ERROR=' IS. 

GO TO FIN, . 

END,. 

DO I = 1 TO NO,. 

00 J = 1 TO NC. 

R(JI =0.0,. /» CLEAR R VECTOR 

/* LOCATE ELEMENT IN OBSERVATION MATRIX AND RELATION CODE 

ICOL =C(1,J),. 

IGO =C(2,JI,. 

IF IGO LT 1 OR IGO GT 6 

THEN DO,. 

ERR0P='2* ,. 

GO TC FIN,, 

END,. 
IF ICOL LT 1 OR ICOL GT NV 
THEN 00,. 

ERROR =*3',, /* INVALID VARIABLE NUMBER 

GO TO FINt. 

END,. 
Q =A(I,IC0LI-C(3,J),. /* FORM R VECTOR 

GO TO T( IGO) ,. 

ni).. 

IF LT 0.0 
THEN GO TP SIO,. 
GO TO S20,. 
r(2).. 

IF Q LE O.C 
THEN GO TO SIO,. 
GO TO S20,. 

ro).. 

IF Q = 0.0 

THEN GO TO SIO,. 

GO TO S20,. 
(4).. 

IF Q NE 0.0 

THEN GO TO SIO,. 

GO TO S20,. 
(5).. 

IF Q GE 0,0 

THEN GO TO SIO,. 

GO TO S20,. 
16).. 

IF LE 0.0 

THEN GO TO S20,. 



CONDITION VALUE INVALID 



SIO.. 

S20.. 



R(J) =I.C, 

END, , 
CALL B 1R,TR) ,. 
Sm =Tfi,. 

END,. 



RETURN, 
END,. 



/* CALCULATE S VECTOR 



/*ENO OF PROCEDURE S8ST 



SBST 10 
******/SeST 20 
*/SBST 30 
IN "/SBST 40 
*/SB5T 50 
'/SBST 60 
*»****/SBST 70 
SBST 90 
SBST 90 
SBST 100 
SBST 110 
SBST 120 
SBST 130 
SBST lAC 
S8ST 150 
SBST 160 
*/SBST 170 
S6ST 180 
SBST 190 
SBST 200 
SBST 21C 
*/SBST 220 
S IS */S6ST 230 
ERD. */SaST 2*0 
SeST 250 
SBST 260 
SBST 270 
SBST 280 
*/SBST 290 
*/SBST 300 
*/S6ST 310 
*/S?ST 320 
SBST 33C 
SBST 34C 
*/SBST 350 
SBST 360 
SBST 370 
SBST 380 
SBST 390 
SBST 400 
SBST 410 
*/SBST 420 
SBST 430 
SBST 440 
*/S6ST 45C 
SBST 460 
SBST 470 
SBST 480 
SBST 490 
SBST 500 
SBST 510 
SBST 520 
SBST 530 
SBST 540 
SBST 550 
SBST 560 
SBST 570 
SBST 580 
SBST 590 
SBST 600 
SBST 610 
SBST 620 
SBST 630 
S8ST 640 
SBST 650 
SBST 660 
SBST 670 
SBST 680 
SBST 690 
SBST 700 
SBST 710 
SBST 720 
SBST 730 
•/SBST 740 
SBST 750 
SBST 760 
SBST 770 
SBST 780 
*/SBST 790 ! 



Purpose: 

SBST derives a subset vector indicating which ob- 
servations in a set have satisfied certain conditions 
on the variables. 

Usage: 

CALL SBST (A, C, R, B, S, NO, NV, NC); 
Parameter B must be declared as an entry attribute 
in the calling program. 

A(NO,NV) - BINARY FLOAT 

Given observation matrix. 
C(3,NC) - BINARY FLOAT 

Given matrix of conditions to be con- 
sidered. The first element of each 
colimin of C represents the nimiber 



R(NC) 



B 



S(NO) 



NO 

NV 
NC 



of the variable (column of matrix A) 
to be tested. The second element of 
each column is a relation code as 
follows : 



1 
2 
3 
4 
5 
6 



• less t2ian 

■ less than or equal to 

■ equal to 
not equal to 

greater than or equal to 
greater than 

The third element of each column is 
a quantity to be used for comparison 
with the observation values. For ex- 
ample, the following column in C: 
2. 
5. 
92.5 
causes the second variable" to be 
tested for greater than or equal to 
92.5. 

BINARY FLOAT 

Resultant working vector used to 
store intermediate results of above 
tests on a single observation. If 
condition is satisfied, R(I) is set to 
1. If it is not, R(I) is set to 0. 
ENTRY 

Given name of subroutine to be sup- 
plied by the user. It consists of a 
Boolean expression linking the inter- 
mediate values stored in vector R. 
The Boolean operators are "*" for 
"and", "+" for "or". 

Example 

BOOL. . 

PROCEDURE (R, T), . 

DECLARE 

(R(*), T) 

FLOAT BINARY, . 
T=R(1)*R(2), . 

RETURN, . 

END, . 
The above tests for R(l) and R(2). 
BINARY FLOAT 
Resultant vector indicating, for 
each observation, whether or not 
proposition B is satisfied. If it is, 
S(I) is nonzero. If it is not, S(E) is 
zero. 

BINARY FIXED 
Given number of observations. 
BINARY FIXED 
Given number of variables. 
BINARY FIXED 

Given number of basic conditions to 
be satisfied. 
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Remarks: 



• Subroutine TABl 



Subroutines and function subroutines required: 

B - The name of the actual subroutine 

supplied by the user may be differ- 
ent from B (for example, BOOL), 
but subroutine SBST always calls B. 
In order for procedure SBST to do 
this, the name of the user-supplied 
procedure must be defined by an 
entry attribute in the calling program. 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR=l - number of observations, nvimber of 
variables , or number of conditions is 
less than or equal to zero. 

ERROR=2 - condition value invalid. 

ERROR=3 - variable number is less than 1 or great- 
er than the number of variables. 

Method: 

The following is done for each observation. Condi- 
tion matrix is analyzed to determine which variables 
are to be examined. The intermediate vector R is 
formed. The Boolean expression (in subroutine B) is 
then evaluated to derive the element in subset vector 
S corresponding to the observation. 



****««**#*****#•**»*******•****«**•**•«***»■ 



T&Bl 
•♦♦/TABl 

*/TA91 

* TO TABULATE FOR ONE VARIABLE IN AN OBSERVATION MATRIX (OR A ♦/TABl 40 

* SUBSET), THE FREQUENCY AND PERCENT FREQUENCY OVER GIVEN */TAei 50 
« CLASS INTERVALS. IN ADDITION, CALCULATE FOR THE SAME VARI ABLEVTABl 60 

* THE TOTAL, MEAN, STANDARD DEVIATION. MINIMUM, AND ♦/TABl 70 

* MAXIMUM. */TABl 80 
« */TABl 90 
♦**«*»»****«**«*********^!*****»«****»******^*^^**^******»^***********/TABl 100 

PROCEDURE (A,S,N0VAR,U80,FReQ,PCT,STATS.N0,NVl,. 
DECLAftE 

EPFOB EXTERNAL CHARACTER (1), 

( I. INN,[NTX.J.K.N0,N0VAR,KK] 

FIXED BINARY, 

(A(*,*J,S(*1,UB0(*1,FPE0{*),PCT(*), STATS t*),SCNT,VHIN,VMAK: 

SlNTtTEMP) 



EINARY FLOAT, 



INN 



ERROR- ' C ' , . 

IF NOVAC LE OR NOVAf GT NV 

THEN DO,. 

ERR0R='6',. 
GO TO S50,. 
END, . 
IF NV LE OR NO LE 
THEN DO,. 

ERROR='l' ,. 

GO TO S50, . /' 

END, . 

=UB0<2) ,. /■ 

= I TO INN,, I 

FREQl J)=O.C,. 

PCT( J)=0.0,. 

END,. 

DO J = 1 TO 5,. 

STATS(Jl=C.O,. 

END,. 
IF UBO(l) GT UB0)3) OR UB0I2) LE 2.0 
THEN DO, . / 

fRRrft='2',. / 

GO TO S5C,. / 

END,. 

00 I = I TO NO,. 

IF St n NE 0.0 

THEN DO,. 



TABl 110 

TABl 120 

TABl 130 

TABl 140 

TABl 150 

TABl 16C 

TABl 170 

TABl 180 

*/TABi iqo 

TABl 200 

/* VALUE QF THE VARIABLE TO BE */TABl 210 

/* TABULATED IS INVALID ♦/TA61 220 

TABl 230 

TABl 240 

TABl 250 

TABl 260 

♦/TABl 270 

/TASl 280 

*/TABl 290 

TABl 300 

♦/TABl 310 

*/TABl 320 

TA81 330 

TABl 340 

TABl 350 

TABl 360 

TABl 370 

TABl 360 

TABl 390 

INVALID BOUNDS OR THE NUMBER^/TABl 400 

OF INTERVALS LESS THAN OR ♦/TABl 410 

EQUAL TO TWO. 



I* NUMBER OF OBSERVATIONS OR 
/» THE NUMBER OF VARIABLES ARE 
/♦ LESS THAN OR EQUAL TO ZERO. 

/♦ CALCULATE INTERVAL SIZE 
/* CLEAR OUTPUT VECTORS 



/* CALCULATE MAX AND MIN 



KK 



= 1, 



VMIN =A(l,NOVARI,. 
VMAX =VM!N. . 
GO TO SIC,. 
END, . 
END, . 
EBRORs'3', . 
GO TO S5C,. 
C. . 

DO I = KK TO NO,. 
IF Sin NE 0.0 
THEN DO,. 

IF A(I,N0VAR1 LT VMIN 
THEN VMIN =A(I ,NOVAP) , . 
IF AdjNOVAR) GT VMAX 
THEN VMAX =Aa,NOVAR),. 
END,. 
END, . 
STATS141=VMIN,. 
STATS(5)=VMAX, . 
IF UB0(1)= UB0(3) 
THEM DO,. 

U601 11=VMIN, . 
UB0i(3»=VMAX, . 
END,. 
SI NT =(UB0(3I-UB01 11 l/(UBO(2)-2) ,. 
SCNT =0.0,. 

DO I = KK TO NO,. 
IF S( I) NE CO 
THEN 00,. 

SCNT =SCNT+1.0,. 

K DEVELOP TOTALS AND FREQUENCIES 



STATSt I } =STATS1 1 »+A{ I ,NOVAR) , 
STATS(3)=STATS(3)»A(I,N0VAR)« 
TEMP =UB011)-SINT,. 
INTX =INN-1,. 

DO J = 1 TO INTX, . 

TEMP =TEMP+SINT,. 

IF A(I,NOVAR) LT TEMP 

THEN 00,. 

K =J, . 

GO TO S2C,. 
END,. 

END,. 
IF A( I.NOVAR) GE TEMP 
THEN DC. 

FREQ(INN}=FREQt INN}+1.0, 

GO TO S30,. 

END,. 



NO OBSERVATION IN SUBSET 



/* TEST SUBSET VECTOR 



•■l.O, 



CALCULATE RELATIVE FREQUENCIES 

DO J = 1 TO INN,. 
PCTIJ)=FREQ1JJ*100.0/SCNT, . 

END, . 

CALCULATE MEAN AND STANDARD DEVIATION 

STATS(2)=STATStl)/SCNT,. 
IF SCNT= 1,0 
THEN DO,. 

ERR0R='4',. 

STATS13I=0.0 

GO TO S50,. 

END,. 
ELSE 00,. 

TEMP =STATS(3I-STATS(1)*STATSI1)/SCNT,. 

IF TEMP IE CO 

THEN DO,. 

ERR0R='5',. /* VARIANCE = 0.0 



SAMPLE SIZE = I 



/TABl 420 
TABl 430 
♦/TABl 440 
TABl 450 
TABl 460 
TAB I 470 
TABl 480 
TABl 490 
TABl 500 
TABl 510 
TABl 520 
*/TABl 530 
TABl 540 
TABl 550 
TABl 560 
TABl 570 
TABl 580 
TABl 590 
TABl 600 
TABl 610 
TABl 620 
TABl 630 
TABl 640 
TA61 650 
TABl 660 
TABl 670 
TABl 680 
TABl 690 
TABl 700 
TABl 710 
TA31 720 
*/TA81 730 
TABl 740 
TABl 750 
TABl 760 
TABl 770 
*/TABl 780 
*/TABl 790 
«/TABl 800 
TABl 810 
TABl 820 
TABl 830 
TABl 840 
TABl 850 
TABl 860 
TABl 870 
TABl 880 
TABl 890 
TABl 900 
TABl 910 
TABl 920 
TABl 930 
TABl 940 
TABl 950 
TABl 960 
TABl 970 
TABl 980 
TABl 990 
TABllOOO 
TABllOlO 
TAeil020 
♦/TAB11030 
♦/TAB11040 
♦/TA611050 
TAB11060 
TAB11070 
TABllCBO 
•/Tfi8llC90 
♦/TA811100 
*/TAB11110 
TAB11120 
TftB1113C 
TAB11140 
*/TAB1115G 
TAB1116C 
TAaillTO 
TAB11180 
TAB11190 
TA811200 
Tfl611210 
TA811220 
*/TflBn230 



Statistics — Data Screening 185 



ELSE 
END, 
S50.. 

RETURN, . 
ENDt . 



STATS13)=0.0,. 
GO TC S5C,. 
END. . 
5TATS(3).S0PI1IE»P/(SCN1-1.011, 



*ENO OF PROCEDURE TABl 



TA611240 
TA6U250 
TAeil260 
TAR11270 
TABU280 
TA911290 
TASllBOO 
*/TAB113lO 



Purpose: 

TABl tabulates for one variable in an observation 
matrix (or a matrix subset), the frequency and per- 
cent frequency over given class intervals. In addi- 
tion, it calculates for the same variable the total, 
mean, standard deviation, minimum, and maximum. 

Usage: 

CALL TABl (A, S, NOVAE, UBO, FREQ, PCT, 
STATS, NO, NV); 

Description of parameters: 

A(NO, NV) - BINARY FLOAT 

Given observation matrix A. 

S(NO) - BINARY FLOAT 

Given vector that indicates which of 
the observations enter the calcula- 
tion. A zero element in S indicates 
that the corresponding observation 
of A is not to be included. 

NOVAR - BINARY FIXED 

Given variable to be tabulated. 

UB0{3) - BINARY FLOAT 

Given vector containing lower limit, 
number of Intervals, and upper limit 
of variable to be tabulated in UBO(l), 
UBO(2), and UBO(3) respectively. 
If lower limit is equal to upper limit, 
the program replaces these with the 
minimum and maximum values of 
the variable. Number of intervals , 
UBO(2), must include two cells for 
values under and above limits. 

FREQ (INN) - BINARY FLOAT 

Resultant vector of frequencies. 
INN is given in UBO(2). 

PCT(INN) - BINARY FLOAT 

Resultant vector of relative fre- 
quencies. Vector length is UBO(2). 

STATS(5) - BINARY FLOAT 

Resultant vector of summaiy statis- 
tics, that is, total, mean, standard 
deviation, minimum, and maximiun. 

NO - BINARY FIXED 

Given number of observations. 

NV - BINARY FIXED 

Given number of variables for each 
observation. 



Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR=l - nvunber of observations or number of 
variables less than or equal to zero. 

ERR0R=2 - invalid boxmds or number of intervals 
less than or equal to two. 

ERR0R=3 - no observations in subset. 

ERROR=4 - sample size equal to one. 

ERR0R=5 - variance equal to zero. 

ERROR=6 - value of the variable to be tabulated is 
invalid. 

Method: 

The interval size is calculated from the given infor- 
mation or optionally from the minimum and maximum 
values for variable NOVAR. The frequencies and 
percent frequencies are then calculated along with 
summary statistics. The divisor for standard de- 
viation is one less than the number of observations 
used. 

Mathematical Background: 

This subroutine tabulates, for a selected variable in 
an observation matrix, the frequencies and percent 
frequencies over class intervals. Interval size is 
computed as follows: 



k = - 



UBO - UBO 
UBO„ - 2 



(1) 



where UBO. = given lower bound 



UBO = given number of intervals 



UBO = given upper bound 



If UBOj^ = UBOg, the subroutine finds and uses the 
minimum and maximum values of the variable. 

A table lookup is used to obtain the frequency, Fj 
of the i™ class interval for the variable, where 

i = 1, 2 UBO2. Then each frequency is 

divided by the number of observations, n, to obtain 
the percent frequency: 



lOOF. 



P. = 

1 n 



(2) 



186 Statistics — Data Screening 



In addition, the following statistics are calcu- 
lated for the variable: 



• Subroutine TAB2 



Total: T = V X.. 
i=l ^•' 



where j = selected variable 



— T 

Mean: X= — 

n 



Standard deviation: 



(3) 



(4) 



s = 




s^> -(£==«; 



n - 1 



(5) 



TAB2.. 



TA82 
*****«**«*«•««*****«*«««/ JAB2 
*/TAB2 
TO PERfORH A THO-HAV CLASSIFICATION OF THE FREQUENCY, */TAB2 

PERCENT FREQUENCY, AND OTHER STATISTICS, OVER GIVEN */TAB2 

CLASS INTERVALS, FC« TWO SELECTED VARIABLES IK AN OSSERVAT ION*/TAii. 
MATRIX. */TA82 

♦/TAB2 



PROCEDURE (A,S,N0V,UB0,FREQ,PCT,STATl,STAT2,N0,NV), 
DECLARE 

ERROR EXTERNAL CHARACTER (11, 

I A(*,*J,UB0(*,*I,FREQ(*,*},PCTC*,*I,STAT1 (*,«!, STAT2C*, 

SI*I.SINTI21,VHIN»VHAX,SCNT,TEHP1,TEMP2> 

BINARY FLOAT, 

tI,INTl,INT2,J,K,KX,L,N,Nl,N2,NO,NOV(»),KK> 

FIXED BINARY,. 



80 
90 

TAB2 100 
TA62 110 
TAB2 120 
TAB2 130 
TAB2 140 
TA32 150 
TA82 160 
>AB2 170 
•/TA62 :80 
TA9i 190 
TA82 200 



ERROR='0',. 

DO 1=1 TO 2,. 

IF NOV(I) LE OR NOVil) GT NV/* INVALID VALUE OF VARIABLE TO*/TA62 2 

THEN DO,. /♦ BE CROSS TABULATED */rAe2 220 

ERR0R-'6',. TAe2 230 

GO TO S50,. TAB2 240 

END,. TAB2 250 

ENOt. TAB2 2t.O 

IF NV LE OR NO LE /• NUMBER OF OBSERVATIONS OR •/TAB2 270 

THEN DO,. /♦ THE NUMBER OF VARIABLES ARE ♦/TA82 280 



ERR0R=»1',. 

GO TO S50,. 

END,. 
INTl =U80(2,lt,. 
INT2 =UB0(2,2>,. 

=N0V(1),. 

=N0V(2),. 

DO I s 1 TO 2,. 

IF UB0I1,II GT U80t3.Il OR UB0(2,I} LE 2.0 



* LESS THAN OR EQUAL TO ZERO. 



N2 



THEN DO, 

ERROR>^ 



*/TA82 290 
TAB2 300 
TAB2 310 
TAB2 320 
TA82 330 
TAB2 340 
TAB2 350 
TA82 360 
TA82 370 



GO TO S50.. 
END,. 
END,. 
00 I ■ I TO INTl,, 

00 J = 1 TO INT2,. 
PCTtI,J)=0.0,. 
FREQ(I,J)=0.0,. 
END,. 
END,. 
DO I = I TO 3,, 

DO J s 1 TO INTl, . 
$TAT1(I,J)=0.0, . 
END,. 

DO J = 1 TO INT2,. 
STAT2U,JI»0.0.. 
END,. 
END,. 

DO I - I TO 2,. 
IF U80ll,n= UBai3,I) 
THEN DO, . 

DO J = I TO NO,. 
IF S(JI NE 0.0 
THEN 00,. 

KK =J,. 
N =N0V(I1.. 
VMAX >AIJ,N1,. 
VMIN =VHAX,. 
GO TO SIO,. 
END,. 
END*. 

DO J = KK TO NO,. 
IF SIJ) NE 0.0 
THEN DO,. 

IF AIJ,N) LT VHIN 
THEN VHIN -AIJ,N), 
IF A(J,N) GT VMAX 
THEN VHAX =A(J,N), 
END,. 
END,. 
UBO(l,II-VMIN.. 
UB0(3,I>-VHAX.. 
END,. 



/* INVALID BOUNDS OR THE NUHBER*/TAB2 380 
/* DP INTERVALS LESS THAN OR •/TABZ 390 



/* EQUAL TO TWO. 



/♦ CLEAR OUTPUT VECTORS 



/• DETERHINE LIMITS 



CALCULATE INTERVAL SIZE 



TO 2,. 
>fUBO(3,J)-UBO(l,J))/(UeO(2,J)-(2+lE-3>).. 



/* TEST SUBSET VECTOR 



DO J > 
SINT(J| 
END,. 
SCNT -O.O.. 

00 J = KK TO NO,. 
IF SUl NE 0.0 
THEN 00,. 

SCNT -SCNT+l.O, . 
TEHP1=UB0I 1, 1 |-S1NT( 1 1 , . 
DO L = 1 TO INTl-1, 
TEMPI=T£HP1«^SINTI1) 
IF AU,N1) LT TEMPI 
THEN DO,. 

K =L,. 
GO TO S20,. 
END,. 
END,. 
K -INTl,. 



STATl(l,KI=SrATlCl,K)+A(J,Nll.. 
STATl(2,Kl=STATl(2,KI+1.0,. 
STAT1(3,K)-STAT1(3,K)+A(J,N1)*«2,. 
TEHP2-UBOU,2)-SINT(2),. 

00 L = I TO INT2-1,, 

TEMP2-TEMP2+SINT (21 , , 

IF A(J,N2) LT TEHP2 

THEN DO,. 



/* CALCULATE FREQUENCIES 



KX 



=L, 



END,. 
KX =INT2,. 

FRE0IK,KX)='FRE0(K,KX)>1.D,. 
STAT2(l,KXl=STAT2(l,KXI+A«J,N2),. 
STAT2(2,KX)*STAT2(2,KX)*1.0,. 
STAT2(3,KX)=STAT2I3,KX1+A(J,N2»**2,. 



*/TAB2 400 
TA82 410 
TA82 420 
*/TAB2 430 
TAB2 440 
TAB2 450 
TAB2 460 
TA82 470 
TAB2 480 
TA82 490 
TAB2 500 
TAB2 510 
TAB2 520 
TAB2 530 
TA82 540 
TAB2 550 
TAe2 560 
TA62 570 
*/TA82 580 
TAB2 590 
TA82 600 
TA82 610 
TAB2 620 
TA82 630 
TAB2 640 
TAB2 650 
TAB2 660 
TAB2 670 
TA82 680 
TAB2 690 
TAS2 700 
TAB2 710 
TA82 720 
TAB2 730 
TAB2 740 
TAB2 750 
TAB2 760 
TAB 2 770 
TAB2 780 
TAB2 790 
TAB2 800 
TAB2 810 
TAB2 820 
TAB2 830 
*/TAB2 840 
*/TAB2 850 
*/TAB2 860 
TAB2 870 
TAB2 880 
TAB2 890 
TAB2 900 
*/TAB2 910 
TA62 920 
TAB2 930 
TAB2 940 
*/TAB2 950 
TAB2 960 
TAB2 970 
TAB2 980 
TAB2 990 
TAB21000 
TAB21010 
TAB21020 
TAB21030 
TAB21040 
TAB21050 
TAB21060 
TAB21070 
TAB21080 
TA621090 
TAB21100 
TAB21110 
TAB21120 
TAB21130 
TAB2Li40 
TAB21150 
TAB21160 
rAB21170 
TAB21180 
TA821190 
TA621200 
TAB21210 
TAB21220 
TA821230 



Statistics— Data Screening 187 







END,. 






TAB21240 






END,. 






TAB21250 




IF SCNT= 0.0 






TAB21260 




THEN 


DO,. 






TAB21270 






ERR0R='3',. /• NO OBSERVATIONS IN 


SUBSET 


*/TAB2I280 






GO TO S50,. 






TAB21290 






END,. 






TAB21300 


/• 










♦/TAB21310 


/• 




CALCULATE PERCENT FREQUENCIES. 






*/TAB21320 


/• 




00 I = 1 TO INTl,. 

DO J - I TO INTZ,. 

PCT(I»J>-FREQ(IfJ)*IOO.O/SCNT,. 

END,. 
END,. 






*/TAB2l330 
TAB21340 
TAB21350 
TAB21360 
TAB21370 
TAB21380 


/♦ 










•/TAB21390 


/♦ 




CALCULATE TOTALS, MEANS, STANDARD DEVIATIONS 






•/TAB21400 


/* 




DO J • I TO INTl,. 
IF STAT1I2,J) LE l.O 
THEN DO,. 






♦/TAB21410 
TAB21420 
TAB21430 
TAB21440 






ERROR='*>,. /• NUMBER OF OBSERVATIONS 


IS 


•/TAB21450 






STATII3,JI=0.0, . /• LESS THAN OR EOUAl 


TO I 


IN 


*/TAB21460 






STAT1(2,J)=STATH1,J1,. /• SOME INTERVAL 






•/TAB2I470 






END*. 






TAB2I480 






ELSE DO,. 






TA621490 






TEHP1=STATI(3,J)-STAT1(I.J)»»2/SIAT1(2,J1,. 






TAB21500 






STAT1(2,J)=SIATIII,J(/STATII2,J1,. 






TAS2151D 






IF TEMPI LE 0.0 






TAB21520 






THEN DO,. 






TAB21530 






ERRORS- 5',. /• VARIANCE IS 0.0 






*/TAB2I540 






STATl(3,J)-0.0,. 






IAB21550 






END*. 






TAB21560 






ELSE STAT1(3,J|.SQRT(TEMPI/(STAT1(2,J)-1.011,. 






TAB21570 






END,. 






TAB215B0 






END,. 






TAB21590 


/* 




00 J - 1 TO INT2,. 
IF STAT212,J) LE 1.0 
THEN 00,. 






♦/TA621600 
TAB21610 
TAB21620 
TAB21630 






ERR0R='4',. /« NUMBER OF OBSERVATIONS 


IS 


*/TAB2L640 






STAT2(3,JI»0.0,. /• LESS THAN OR EOUAL 


TO 1 


IN 


•/TAB216;0 






STAT2(2,J)=STAT2(1,JI,. /* SOME INTERVAL 






•/TAB21660 






END,. 






TAe21t70 






ELSE DO,. 






TAB21660 






STAI2I2,J)=STAT2(1.J)/STAT2I2,J).. 






TAB21690 






TEMP2«STAT213,JI-STAT2II,J1*«2/STAT2I2,J),. 






IAB21700 






IF TEMP2 LE 0.0 






TAB217X0 






THEN DO,. 






TAB21720 






ERROR-'?',. /• VARIANCE - 0.0 






♦/TAB21730 






STAT2(3,J>-0.0,. 






TAB21740 






END,. 






TAB21750 






ELSE STAT2(3,JI=SQRIITENP2/(STAT2I2,JI-1.01I,. 






TAB21760 






END,. 






TAB21770 






END,. 






TAB21780 


S50.. 








TAB2 17901 




RETURN. . 






rAB21800l 




END 


/*ENO OF PROCEDURE TAB2 




•/TAe218lO! 



UBO(3,2) 



Purpose: 

TAB2 performs a two-way classification for two 
variables in an observation matrix (or a matrix sub- 
set), of the frequency, percent frequency, and other 
statistics over given class intervals. 

Usage: 

CALL TAB2 (A, S, NOV, UBO, FREQ, PCT, 
STATl, STAT2, NO, NV); 

Description of parameters: 



A(NO, NV) 
S(ND) 



NOV(2) 



BINARY FLOAT 
Given observation matrix. 
BINARY FLOAT 

Given vector that indicates which 
of the observations enter the cal- 
culation. A zero element in S 
indicates that the corresponding 
observation of A is not to be 
included. 
BINARY FIXED 
Given variables to be cross- 
tabulated. NOV(l) is variable 1; 
N0V(2) is variable 2. 



FREQ 
(INTl, INT2) 



PCT 
(INT1,INT2) 

STATl 
(3, INT2) 



STAT2 
(3,INT2) 

NO 

NV 



Remarks: 



BINARY FLOAT 
Given matrix giving lower limit, 
number of intervals, and upper 
limit of both variables to be tab- 
ulated (first column for variable 1, 
second column for variable 2). If 
lower limit is equal to upper limit 
for a variable, the program 
replaces these with the minimxun 
and maximum values of that vari- 
able. Number of intervals must 
include two cells for under and 
above limits. 
BINARY FLOAT 

Resultant matrix of frequencies in 
the two-way classification. INTl 
equals UB0(2,1) and INT2 equals 
UBO(2, 2) where UB0(2, 1) is the 
number of intervals of variable 1 
and UBO(2 , 2) is the number of 
intervals of variable 2. UBO(2, 1) 
and UB0(2 , 2) must be specified in 
the second position of the respec- 
tive coliunn of UBO matrix. 
BINARY FLOAT 
Resultant matrix of percent 
frequencies. 
BINARY FLOAT 
Resultant matrix summarizing 
totals, means, and standard devi- 
ations for each class interval of 
variable 1. 

Same as STATl but over variable 

2, 

BINARY FIXED 

Given number of observations. 

BINARY FIXED 

Given nxunber of variables for 

each observation. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERR0R=1 - number of observations or number of 
variables less than or equal to zero. 

ERR0R=2 - invalid bounds or number of intervals 
less than or equal to two. 

ERROR=3 - no observations in subset. 

ERR0R=4 - number of observations one or less in 
some interval. 
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ERROR=5 - variance equal to zero. (If error con- 
ditions 4 and 5 exist, the last condition 
encountered overrides.) 

ERROR=6 - invalid value of variable to be cross- 
tabulated. 

Method: 

Interval sizes for both variables are calculated from 
the given information or optionally from the minimum 
and maximum values. The frequency and percent 
frequency matrices are developed. Matrices STATl 
and STAT2 summarizing totals, means, and stan- 
dard deviations are then calculated. The divisor for 
standard deviation is one less than the number of 
observations used in each class interval. 

Mathematical Background: 

This subroutine performs a two-way classification 
of the frequency, percent frequency, and other sta- 
tistics over given class intervals , for two selected 
variables in an observation matrix. 

Interval size for each variable is computed as 
follows: 



k. = 



UBO^. - UBO,. 
3] 1] 

UBO„. - 2 



(1) 



where UBO . = given lower bound 



UBO = given number of intervals 



UBO . = given upper bound 

•5] 







fn 


^22 










lower 
















bound *^ 
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variable 


upper 
bound 



Figure 10. Frequency matrix 



where i = 1, 2, ..., UBO, 



21 



j =1, 2, ..., UBO. 



22 



As data are classified into the frequency matrix, the 
following intermediate results are accumulated for 
each class interval of both variables: 
1. Number of data points, n 



2. Sum of data points , ^ X. 
i=l ^ 



j=l, 2 

if UBOy = UBOgj, the subroutine finds and uses the 
minimum and maximum values of the i^^ variable. 

A frequency tabulation is then made for each pair 
of observations in a two-way table as shown in 
Figure 10. 

Symbols > and < in Figure 10 indicate that a 
coimt is classified into a particular interval if the 
data point is greater than or equal to the lower limit 
of that interval but less than the upper limit of the 
same interval. 

Then, each entry in the frequency matrix, Fj^, is 
divided by the number of observations, N, to 
obtain the percent frequency: 



P.. 
1] 



lOOF.. 
il 

N 



(2) 



3. Sum of data points squared, ^ X. 

i=l ^ 



From these, the following statistics are calculated 
for each class interval: 

n 

Ex, 



Mean: X = 



i=l 



(3) 



Standard deviation: 



n 2 /n 



.^,<- .2:^i 



s = 



i=l 



i=l 




n - 1 



(4) 
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• Subroutine SUBM 



SUBM.. 


SUBM 10 


/**i-*************t**********»******************iLt*****»****m********m*/$UBH 20 1 


/* 


*/SUBH 30 


/* BASED ON VECTOR S DERIVED FROM PROCEDURE SBST OR *BST, THIS 


4-/SUBM 40 


/* PrtOCEDURf CnpiES FROM A LAPGEP MATRIX OF OBSERVAT ION DATA A 


*/SUBM 50 


/* SUBSET MATRIX OF THOSE OBSERViTIONS WHICH HAVE SATISFIED 


*/SUBM 60 


/* CERTAIN CONDITIONS. 


VSUBH 70 


/* 


♦/SUBM 80 


/****************0»*****m*****».*******t>**)t»m*»*****m*»:t*******»***^tt 


**/SUBM 90 


PROCEDURE (A.0,SfNO,NV.N),. 


SUBM 100 


DECLARE 


SUBM 110 


t I.N, NO) 


SUBM 120 


FIXED 8INAPV, 


SUBM 130 


ERROR EXTERNAL CHARACTER( I) . 


SUBM 140 


(AI«.*I ,D(*,*),S(*)) FLCAT BINARY,. 


SUBM 150 


/* 


•/SUBM 160 


ERROR-'C ,. 


SUBM 170 


D =C, . 


SUBM 180 


N >0>. 


SUBM 190 


IF NV L6 OR NO LE /# NUMBER OF OBSERVATIONS OR 


*/SUBM 200 


THEN E^ROR-'IS, /♦ THE NUMBER OF VARIABLES ARE 


•/SUBM 210 


Et-SE 00., /* LESS THAN OR EQUAL TO ZERO. 


*/SUBM 220 


DO I « 1 TO NO,. 


SUBM 230 


IF S(I) NE 0.0 


SUBM 240 


THEN DO,. 


SUBM 250 


N »N+1,. 


SUBM 260 


DO J * 1 TO NV.. 


SUBM 270 


D1N,J»=A(I.J),. 


SUBM 280 


END,. 


SUBM 290 


END,. 


SUBM 300 


END.. 


SUBM 310 


END,. 


SUBM 320 


RETURN,. 


SUBM 330 


tNO». /SEND OF PROCEDURE SUBM 


*/SUBM 3*0 



The following constitutes the possible error con- 
dition that may be detected: 



Purpose: 

SUBM copies a submatrix from an observation ma- 
trix. The elements of this submatrix satisfy con- 
ditions specified by an input vector. This subroutine 
is used in preparing data for input to a statistical 
analysis such as multiple regression. 

Usage: 

CALL SUBM (A, D, S, NO, NV, N) ; 

Description of parameters: 
A(NO,NV)- BINARY FLOAT 

Given matrix of observations. 
D(N, NV) - BINARY FLOAT 

Resultant matrix of observations. 
S(NO) - BINARY FLOAT 

Given vector containing the codes 

derived from procedures SBST or 

ABST. 
NO - BINARY FIXED 

Given number of observations. 
NV - BINARY FIXED 

Given number of variables for each 

observation. 
N - BINARY FIXED 

Resultant variable containing the 

number of nonzero codes in vector S. 

Remarks: 

Matrix D can be in the same location as matrix A. 

If no errors are detected in the processing of 
data, the error indicator, ERROR, is set to zero. 



ERROR=l 



Method: 



number of observations or number of 
variables less than or equal to zero. 



If S(I) contains a nonzero code, the I-th observation 
is copied from the input matrix to the output matrix. 



190 Statistics — Data Screening 



Elementary Statistics 
• Subroutine MOMN 



M3MN . , 


MOMN 10 


/«*i|i***«*>i<****«*ti>ti]«**iii*«««w««««««**«***«***«**«c*****««*>«**>t"*««*******/HOMN 20 1 


/* 


*/MOMN 30 


/* Tn fIND THE FIRST FOUR MOMENTS FOR GROUPEO DATA ON EQUAL 


•/MOMN *0 


/« CLASS INTERVALS. 


*/MOMN 50 


/• 


•/MOMN 60 


/*****m**'r*<f******»***»**************«****m********»***»**«******»»'***/HOm 70 | 


PPOCEOUPS (F,UBO,NQPiANS)i. 


MOMN BO 


OECLARE 


MOMN 90 


(FtWJiUBOC*) .ANS(4V,TtEtEE) 


MOMN 100 


BINARY FLOAT, 


MOMN 110 


ERROR EXTERNAL CHARACTER 11) t 


MOMN 120 


(I.JDMPtNGP) 


MOMN 130 


FIXED BINARY, 


MOMN lAO 


S<5) LABEL,. 


MOMN 150 


/* 


•/MOMN 160 


T «0,. /* INITIALIZE 


•/MOMN 170 


ANS -C. 


MOMN IBO 


ERROR-'C. 


MOMN 190 


IF UB0(2) ST UBCOI - UBO(H 


MOMN ZOO 


THEN DO, , 


MOMN 210 


ERR0R«'2',. /* INCORRECT NO. OF INTfiRVALS 


•/MOMN 22P 


GO TO Sll),. /* FOR THE SPECIFIED BOUNDS 


•/MOMN 230 


END,. 


MOMN 2« 


IF UBQ(l) GT UBQI3) OR UBOtZ) LE C /« INVALID BOUNDS 


•/MOMN 250 


THEN OOf . 


MOMN 260 


FRdOR-'l',. 


MOMN 270 


GO Tn S{U,. 


MOMN 2eO 


END,. /• CALC. NO. OF CLASS INTERVALS*/MOMN 290 I 


N ■FLOOPKUBOOl-UnOd) l/UBOt2> + l.0E-?),. 


MOMN 30C 


Oil I = 1 TO N,. /* CALCULATE TOTAL FREQUENCY 


*/MOMN 310 


T »T+F(I),. 


MOMN 320 


END,, 


MOMN 330 


JU1P »2,, 


MOMN 3*0 


IF NOP r,B 5 


MOMN 350 


THEN DO,. 


MOMN 360 


NPP «5,. 


MOMN 370 




MOMN 390 




MOMN 39C 


E -U30( l)-C.5*UBO(21,. 


MOMN *00 


00 I ■■ 1 TO N,. /* FIRST MOMENT 


• /MDMN '.lO 


E =E * UB0(2»,. 


MOMN 420 


ANS(l)=ANSn)*F(!)*E,, 


MOMN 430 


tN':),. 


MOMN 440 


ANStD^fiNSI n/T,. 


MOMN 450 


E =ueO( n-C.5*UBC(21-ANS(l).. 


MOMN 460 


S(51 ='=(2),. 


MOMN 470 


GO TO SfNDP),. 


MOMN 480 


S12I.. 


MOMN 490 


EE =E,. 


MOMN 500 


00 I = 1 TO N,. /* SECOND MOMENT 


*/MOMN 510 


EE =EE*UBC(2),. 


MOMN 520 


ANS(2» = ANS(2l*Fn)*E£»*2,. 


MOMN 53C 


ENO,. 


■^QMN 54C 


aNS(2)=aNS(21/T,. 


MOWN 55C 


IF JUMP= 2 


KOMN 560 


THEN GO in S(l),. 


r'OMN 57C 


S13).. 


MOMN 580 


EE =E,. 


MOMN 59C 


00 ] = 1 TO N,. /* THIRD MOMENT 


*/MCMN 600 


eS =EE*UB0(2),. 


MOMN 610 


fiNS13)=ANS(31*-F(I)*EE**3,. 


MOWN 62C 


tNO,. 


■'Om 630 


ANS13)=aNS(3)/T,. 


MOMN 64C 


IF JUMP = 2 


MOMN 65C 


THEN GO TO SU),. 


MHMN 66C 


S(4».. 


MOMN 6TC 


EE =E,. 


MOMN 68G 


00 I = 1 TO N,. /* FOURTH MOMENT 


t^/mm 690 


Et =EEtUBC(2»,. 


MOMN 7 CO 


ANS(A)=ANS(<.UF(I J*EE**4,. 


MGMN 71C 


END,. 


MOMN 720 


ANS(*)=ANS1^)/T,. 


MOMN 730 


SU).. 


MOMN 740 


RETURN,. 


MOMN 75C 


END,. /* END PROCEDURE "PMN 


*/MPMN 76C 



Purpose: 

MOMN finds the first four moments for grouped 
data on equal class intervals. 

Usage: 

CALL MOMN (F, UBO, NOP, ANS); 

F(N) - BINARY FLOAT 

Given vector containing grouped data, 
(frequencies), where N is the number 
of class intervals. 

UB0(3) - BINARY FLOAT 

Given vector containing the lower bound, 
UBO(l), the class interval, UBO(2), and 
the upper limit, UBO(3). 



NOP - BINARY FIXED 

Given option code with the following 

values: 

N0P=1 calculate first moment 

N0P=2 calculate second moment 

N0P=3 calculate third moment 

NOP=4 calculate fourth moment 

NOP=5 calculate all four moments 

ANS(4) - Resultant vector containing the moments 
calculated. 

Remarks: 

Note that the first moment Is not central but the 
value of the mean Itself. The mean Is always 
calculated. Moments are biased and not corrected 
for grouping. 

If no errors are detected in the processing of 
data, the error Indicator, ERROR, Is set to zero. 
The following constitute the possible error con- 
ditions that may be detected: 

ERR0R=1 - lower bound greater than upper 

bound or number of intervals less 
than or equal to zero. 

ERR0Rr=2 - incorrect number of intervals for 
the specified bounds. 

Method: 

Refer to M. G. Kendall, The Advanced Theory of 
Statistics, vol. 1, Hafner Publlshir^ Company, 1958, 
Chapter 3, 

Mathematical Background: 

This procedure computes four moments for grouped 
data Fi, F2, . . . , Fjj on equal class intervals. The 
number of class intervals is computed as follows: 

where: 

N = (UBO3 - UB0j)/UB02 

UBO]^ = ^ven lower bound 

UBO2 = given class interval 

UBO3 = given upper bound 
and the total frequency 

N 



T-E 



i=l 
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where Fj = frequency in the i-th interval. 
If we set 

X. = UBO^ - 0. SUBOg + i UBOg 1=1 n 

then the first moment (mean) 



• Subroutine TTST 



ANS, = 1/T V F.X. 
1 i—' I 1 



N 

C 

i=l 



^th 



and the j"^ moment (j=2,3,4) is 

. = 1/T 
3 



ANS. = 1/T y^ F. (X, - ANSJ ^ 
3 *-^ 1 M 1' 



i=l 



These moments are biased and not corrected for 
grouping. 



TO FIMO CERTAIN T-ST ATI STI CS ON THE MEANS OF POPULATIONS. 
******* ************«»*«44,^##^*^*«^ J, ^.^^^,^^,^^^^^^^^^^^^^^^^^^^^ 
PROCEOURf ( A,NA.B,NP,N0P,NDF,ANS1 ,. 
DECLARE 

EPfiO= EXTERNAL CHflCACTEfi (II, 

(fl(«l,fi(*},flNS,flMEAN,BMEAM,FNA,FN8,SA2,Se2tS,Al,A2) 
FLOAT BINARY, 



(T(6)) LABEL, 

NOF ='C',. 

ERROR='C ' , . 

ANS =0.C,. 

IF NOP LT I OP NOP GT 4 

THEN DO,. 

ERPOR=' IS. 

GO TO FIN,. 

END, . 
IF N0P=1 AND NA NE 1 
THEN CD,. 

ER«0fi='5' ,. 

GO TO f IN, . 

END,. 
IF NOP='i AND NB NE NA 
THEN DC. 

EfiR0R='6' ,. 

GO TO FIN, . 

END.. 

TEST SAMPLE SiZE 

IF NA LE 1 
THEN on, . 

IF NOP GT i 

THEN DO,. 

EftR0R='2' ,. 
GO TO FIN, . 
END, . 

END,. 
IF NB LE I 
THEN DO,. 

ERP0R='2',. 

GO TO FIN,. 

END, . 

=NA, . 

=NB, . 
ft«EAN=0.O. . 

DO I = I TO NA,. 

AMEAN=AMEANtA( I),. 

ENO,. 
AHEAN=AHEAN/FNA, . 
BMEAN=O.C,. 

00 I = 1 TO NB,. 

BMEAN=6MEAN*S(n,. 

END.. 
BM6AN=BMEAN/FN6,. 

CALCULATE THE VARIANCE OF A 



MTSr 5C 

/tt::t 60 

TTST 
TTST 

rrsT 

ITSl 100 

TTST no 



t: 



120 



INITI ALiZATION 



WRONG OPTION CODE 



■■ NA MUST BE I WHEN NaP=l 



NA MUST EQUAL NB WHEN NOP^ 



FNA 
FNB 



' FIRST SAMPLE FPft npTIONS 
-■ Z-*t IS 1 OR LESS 



/* SECOND SAMPLE SIZE IS I OR 
/* LESS 



CALCULATE MEAN OF A 



/* CALCULATE MEAN OF B 



IF NOP LT 

THEN DO, . 

SA2 



<» AND NOP GT 1 



=0.C,. 

00 I = 1 TO NA,. 

SA2 =SA2t(A(l|-AMEAN)« 

END, . 
SA2 =SA2/(FNA-l.0» ,. 
IF SA2 LE 0.0 
THEN 00,. 

ERROR=' 3',. 

GO TO FIN,. 

END,. 
END. . 
IF NOP LT 4 
THEN DO, . 
SB 2 



FIRST SAMPLE VARIANCE 



= 1 TC NB,. 

=SB2+(BI I)-BMEAN)**2, 



.0),. 



/* SECOND SAMPLE VARIANCE 



=c.c. 

DC I 

sa2 

END.. 
SB2 =SB2/{FNS- 
IF 582 LE CO 
THEN 00,. 

ERROR=' 3* ,. 
GO TO FIN, 
PND,. 
END.. 
GO TO TINOP),. 
T'l>-' /* OPTION ONE 

ANS =((8MEAN-AMEAN)/S0RT(SB2n*SQRTtFN81,. 
NOF =NB-1,. 
GO TO FIN,. 
T<2).. /* OPTION TMO 

NOF =NA+NB-2, . 

S =SORT(( (FNA-1.C)*SA2+(FNB-1.C)*SB2)/NDF),. 
ANS =l(BMEAN-AMEANI/S)*(1.0/S0RT(l.C/FNA*l.0/FNB)),. 
GO TO FIN, . 
■"■131.. /* OPTION THREE 

ANS =(RME4N-AMEAN)/SQRT(SA2/FNA+S62/FNB1,. 
A I =( SA2/FNA+SB2/FNB)**2,. 

=(SA2/FNA)**2/(FNA+l.C)t(SB2/FNB)**2/(FNB*1.0l,. 
=Al/A2-2.0+C.5,. 
GO TO FIN, . 
T(4).. 

Al =5MEAN-AMEAN, 



DO I = 1 TO NB,. 

A2 =A2+(8m-Am-Al)» 

ENO, . 
IF A2 LE CO 
THEN DO, . 

fFR(3= = '<V' , . 

GO TO FIN,. 

END,. 
A2 =S0RT(A2/{FN8-l.Cn ,. 

= (A1/A2)*S0F.T(FNB»,. 

=N?-1.. 



NOF 



/* OPTION FOUR 



ANS 
NDF 
FIN.. 

RETURN 
ENO,. 



/* TWO SAMPLES ARE IDENTICAL 



/*ENO OF PROCEDURE TTST 



*/TT^' 
*/TTST L4C 
TTST 15C 
TTST 16C 
TTST 170 
TTST 180 
'■/TTST 190 
TTST 200 
TTST 21C 
TTST 220 
*/TTST 230 
TTST 240 
TTST 250 
TTST 260 
TTST 270 
*/TTST 260 
TTST 2^0 
TTST 300 
TTST 
*/TTST 
*/TTST 33C 
"/TTST 34C 
TTST 350 
TTST 360 
TTST 37C 
TTST 380 
*/TrST 390 
"■/TTST 400 
TTST 410 
TTST 42C 
TTST 43C 
TTST 440 
*/TTST 45C 
*/TTST 46C 
TTST 470 
TTST 480 
TTST 490 
•/TTST 500 
TTST 510 
TTST 520 
TTST 530 
TTST 540 
•/TTST 550 
TTST 560 
TTST 570 
TTST 580 
TTST 590 
♦/TTST 600 
♦/TTST 610 
*/TTST 620 
TTST 630 
TTST 640 
TTST 650 
TTST 660 
TTST 670 
TTST 680 
TTST 690 
TTST 700 
TTST 710 
0.0 ♦/TTST 720 
TTST 730 
TTST 740 
TTST 750 
TTST 760 
TTST 770 
TTST 780 
TTST 790 
TTST 800 
TTST 810 
TTST 820 
TTST 830 
TTST 840 
0.0^/TTST 850 
TTST 860 
TTST 870 
TTST 880 
TTST 690 
♦/TTST 900 
TTST 910 
TTST 920 
TTST 930 
♦/TTST 940 
TTST 950 
TTST 960 
TTST 970 
TTST 980 
♦/TTST 990 
TTSTIOOO 
TTSTIOIO 
TTST1020 
TTST1030 
TTST 1 040 
♦/TTST1050 
TTST I 060 
TTST1070 
TTST1080 
TTST I 090 
TTSTllOO 
TTSTlllO 
TTST1120 
♦/TTST1X30 
TTST1140 
TTST1150 
TTST 1160 
TTSTU70 
TTST1180 
TTST1190 
TTST1200 
♦/TTST121C 
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Purpose: 

TTST calculates certain t-statistlcs on the means 
of populations. 

Usage: 

CALL TTST (A, NA, B, NB, NOP, NDF, ANS) ; 



A(NA) • 
NA- 
B(NB) ■ 
NB- 
NOP- 



NDF. 



ANS 



BINARY FLOAT 

Given vector containing data. 

BINARY FIXED 

Given number of observations in A. 

BINARY FLOAT 

Given vector containing data. 

BINARY FIXED 

Given number of observations in B. 

BINARY FIXED 

Given options for various hsrpotheses: 

N0P=1 - That population mean of B = 
given value of A (set NA=1). 

NOI*=2 - That population mean of B = 
population mean of A, given 
that the variance of B = the 
variance of A. 

NOP=3 - That population mean of B = 
population mean of A, given 
the variance of B is not equal 
to the variance of A. 

NOP=4 - That population mean of A = 
population mean of B, given 
no information about variance 
of A and B (set NA = NB). 

BINARY FIXED 

Resultant variable containing degrees of 

freedom associated with t-statistic 

calculated. 

BINARY FLOAT 

Resultant variable containing t-statistic. 



Remarks: 



NA and NB must be greater than one, except that 
NA=1 in option 1, NA and NB must be the same in 
option 4. H NOP is other than 1,2,3, or 4, degrees 
of freedom and t-statistic will not be calculated. 
NDF and ANS will be set to zero. 

If no errors are detected in the processing of 
data, the error indicator, ERROR, is set to zero. 
The following constitute the possible error con- 
ditions that may be detected: 

ERROR=l - invalid option code. 

ERROR=2 - sample size of one of the variables is 

less than or equal to 1 (except 

variable A in option 1). 



ERR0R=3 - variance of one of the variables is 

zero. 
ERROR=4 - two samples identical. 
ERROR=5 - NA must be 1 when NOP is 1. 
ERROR=6 - NA must equal NB when NOP is 4. 

Method: 

Refer to Ostle, Bernard, "Statistics in Research", 
Iowa State College Press, 1954, Chapter 5. 

Mathematical Background: 

This subroutine computes certain t-statistics on the 
means of populations under various hypotheses. 

The sample means of Aj, A2 A^a, and 

Bi, B2, ..., Bjsjg are normally found by the 
following formulas: 



NA 



NB 



Z^ 



Z^i 



A^ ^=1 



B = -^=l 



NA ' ~ NB 

and the corresponding sample variances by: 



(1) 



SA' 



NA 

I 

2 i=l 



Z'^ 



NB 



A)2 



Z <^i-^)' 



NA- 1 



SB' 



,2 i=l 



NB- 1 



(2) 



The quantities n and a^ stand respectively for pop- 
ulation mean and variance in the following hypotheses. 

Hypothesis: jUg= A; A= a given value (option 1). 

Let B = estimate of ju and set NA = 1 (A is stored 
in location A,). 

The subroutine computes: 

ANS 



SB 
NDF = NB - 1 



B- A rz 

y NB (t-statistics) (3) 

(degrees of freedom) 

(4) 



Hypothesis: M^=Mg;(CT^= ct|\ (option 2) 

The subroutine computes: 
B- A . 1 



ANS = 



VnA NB 



(t-statistics) 



(5) 
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NDF = NA + NB - 2 (degrees of freedom) 



(6) 



Correlation and Regression Analysis 
• Subroutine CORR 



where S=M^-y/:f^^)^^' 
V NA + NB - 2 



(7) 



Hypothesis: *^^= M^; \<yp^^ CTg) (option 3) 



The subroutine computes: 

ANS = il-A 



(t- statistics) 



(8) 



9 2 

SA SB 

NA "^ NB 



NDF = 



/sai sB^y 

\ NA "^ NB / 




(NA + 1) + 




(9) 
' -2 



(NB + 1) 



NB 
(degrees of freedom) 



Note: The program returns a rounded NDF, not a 
truncated NDF. 

Hypothesis: fi = /i • mo assumption on a ) 
(option 4) 



««**«**«**««*****« 



COftP 

**«*»***/rORR 

*/f:ORR 

TO COMPUTE MEANS, STANDARD DEVIATIONS, SUMS OF CROSS-PRODUCTS*/CORR 

Of DEVIATIONS, AND CORRELATICN COEFFICIENTS. */CORR 

*/CORR 

PROCEDURE (N,M,10,X,XBAR,ST0,PX,C,B),. 
DECLARE 

ERROR EXTERNAL CHARACTER (11, 

(I ,10. J,K,KK,M,N) 

FIXED BINARY, 

{X(*,«),D(MI ,FN,FKK) 

FLOAT BINARY, 

tR{*,*),RXl*,*>,X6AR(*) ,STD(*),B(*),HHn 

BINARY FLOAT,. /*$INGLE PRECISION VERSION 

/♦DOUBLE PPECISION VERSION 



81^IARY FLOAT (53) , 



ERROR = 



IF N 


IE r 


OR H 


LE C 


THEN 


DO,. 








ERROR='l' 






GO TO FIN 






END, 






FN 


^N,. 






T 


= 0.0 








DO I 


= ! 


H,. 




6t I t 


=0.0 








00 J 


= I TO M,. 






»(I, 


J1=0.C,, 






END, 






END, 






IF 10 NE 






THEN 


00,. 










00 J 


= I TO M,. 

DO I = I TO N,. 

T(J) =T(J)*X(I,J) 

END,. 






XaAR{J)=T(J),. 






T(J) 


=T( J)/FN,. 






FND, 








00 I 


= 1 TO N,. 
DO J = 1 TO M,. 
0(J» =X(1,J)-- 
8(J1 :'6(J)*r 

END,. 



/* THE NUMBER OF OBSERVATIONS 

/* OR THE NUMBER OF VARIABLES 

/* ARE LESS THAN OR EQUAL TO 
/* ZERO. 

/• INITIALIZATION 



END.. 
GO TO CA- 

END, . 



The subroutine computes: 
D 



ANS = - .^ 
NDF = NB - 1 

where D = B - A 



NB 



(t-statistics) (10' 

(degrees of frec^" 



AT IONS FROM 



SD = 



NB _ 

J] (B.-A.-D)2 

NB- 



TIKE, SUM THE 
iOOOCTS OF 



NA= NB 



JUST SUMS OF CROSS-PRODUCTS OF DEVIATIONS FROM TEMP. MEANS 



00 I = I TO M,. 
X8AR(I)=X8AP(n/FN,. 



/« CALCULATE MEANS. 



PX( I,J)=P(I ,J)-B(I )*9(J)/FN, 
RX(J,I)=RX(I,JI ,. 

END,. 



CORR 
CORR ' 
CORR IOC 
CORR 110 
CORR 12C 
CORR 130 
COPP 140 
CORR 150 
/*S*/CnRR 160 
/*0*/COPP 170 
«/CQRR 180 
CORR 190 
*/rORR ZOO 
*/COfiH 210 
*/CORR 220 
l^/CORR 230 
CORR 240 
*/CORR 250 
CORR 260 
CORR 270 
CORR 2 
COPR 290 
CORR 300 
CORR ^10 
CnRR 320 
CORR 330 
CORR 340 
*/CCRR 350 
CORR 360 
CORR 370 
CfRR 380 
CORP 390 
CORR 400 
CORR 410 
COPR 420 
COHR 430 
rORR 44C 
CORR 450 
CORR 460 
CGRR 470 
CORR 4 
CORR 490 
rORR 500 
CORR 510 
CORR 520 
CORR 530 
CORP 540 
*/CORR 550 
*/CORR 560 
*/COPH 570 
CORR 5 
CORR 590 
COPR 600 
CORR 61C 
CORR 620 
CnRR 630 
CORR 640 
CO-^R 650 
CHRR 660 
CORR 670 
CORR 680 
CORR 690 
COPR 700 
CORR 710 
CORR 720 
*/CORP 73C 
•/CORR 740 
*/CORR 750 
*/CORo 760 
CORR 770 
CORR 760 
CORR 790 
rORR 800 
CORR 81C 
CHRR 820 
CORR 830 
CORR 840 
CORR 850 
CORR 860 
CORR 870 
CORR 880 
*/COPP 890 
*/CORR 900 
*/CORR 910 
*/CORR 92C 
*/CORR 930 
CORR 940 
CORP 950 
CORR 960 
CORR 970 
CORR 980 
CORR 990 
CORR 1000 
CORPIOIO 
CORR I 020 
C0RR1030 
CnRR1040 
CORR 1050 
C0RB1060 
C0RR1070 
C0RR1080 
*/C0RRl090 
♦/CORRllOO 
*/C0RR1110 
CO PR 1120 
C0RR1130 
*/C0RRll40 
C0PP1150 
C0RR1160 
C0RR1170 
CORR1180 
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STDll) = SOFT(flBS(''X(I,I) )) ,. 

COPY THE DIAGONAL OF THE MATRIX PF SUMS OF CROSS PRODUCTS OF 

DEVIATIONS FOOM THE MEANS. 





P( I) 


=fixn,i I,. 




END, 






COMPUTE CORRELATION COEFFIC 




DO J 


= 1 TO M,. 

00 K = J TO M,. 

FKK =STD( J)*STDIK),. 

IF FKK= 0.0 

THFN DO,. 

FRRnR=*2' ,. 

P( J,K)=0.0,. 

END,. 
ELSE R(J,K)=RXIJ,K)/FK 
R(K,J)=PIJ,K),. 
END, . 




END, 






COMPUTE STiNDAfiO DEVIATIONS 




IF f 


= 1 




THEN 


00,. 

DC 1=1 TO N,. 

SToin -c. 

END,. 

GO TO FIN,. 

E^'D, . 




FN 


sSORTIN-1),. 




DO 1 


= L TO M,. 




STr)(II = STOII)/fN,. 




END, 




RETURN,. 




END 







SOME VARIANCES ARE ZERO 



/*END OF PROCEDURE CORR 



C0RR1190 

♦/CDRR1200 

*/C0fiR1210 

'/C0RR1220 

*/C0RR1230 

C0RR12^C 

C0BR1250 

*/CORR1260 

•/CDRR1270 

•/C00R128C 

C0RR1290 

C0RR13C0 

CORR1310 

C0RR1320 

CQRR1330 

CORR1350 
C0RR1360 
C0RR137C 
CnpB1380 
C0RR13qC 
CORRMOC 
*/C0RPl41C 
♦/C0RR1420 
*/CORRl430 
C0PBU4C 
CORR 1450 
CORR 1460 
C0RR1470 
C0RR1480 
C0RR1490 
CnRR1500 
CORR1510 
C0RR1520 
C0RR153C 
C0RR1540 
C0RR155C 
C0RR1560 
•/C0RR1570 



Purpose: 

CORR computes means, standard deviations, sums 
of cross-products of deviations, and correlation 
coefficients. 

Usage: 

CALL CORR (N, M, 10, X, XBAR, STD, RX, R, B); 

Description of parameters: 
N - BINARY FIXED 

Given number of observations. 
M - BINARY FIXED 

Given number of variables for each 

observation. 
lO - BINARY FIXED 

Given option code for input data. 
X(N, M) - BINARY FLOAT 

IO=0 If data are to be read in from 
input device in the special pro- 
cedure named DAT2 (see 
"Remarks"). 

IOt^O If all data are already in core. 

If IO=0, X is not used. 

If I(VO, X is the input matrix contain- 
ing data already in core, 
XBAR(M) - BINARY FLOAT [(53)] 

Resultant vector of length M containing 

means. 
STD - BINARY FLOAT [(53)] 

Resultant vector of length M containing 

standard deviations. 
RX(M, M)- BINARY FLOAT C(53)] 

Resultant matrix (M by M) containing 



R(M, M) - 
B(M) - 



sums of cross-products of deviations 

from means. 

BINARY FLOAT [ (53)] 

Resultant matrix (M by M) containing 

correlation coefficients. 

BINARY FLOAT [(53)] 

Resultant vector of length M containing 

the diagonal of the matrix of sums of 

cross-products of deviations from 

means. 



Remarks: 



Subroutines and function subroutines required: 

DAT2(M, D). This subroutine may be provided by 
the user, but a suitable subroutine is used in several 
of the sample programs (for example, see REGR). 
Note that in using this procedure, the parameters 
NCARD and NV must be declared external and the 
proper values must be assigned to them. 

1. If IO=0, this subroutine provides an obser- 
vation in vector D from an input device. 

2, If lOji^O, this procedure is not used by CORR 
but must be in the job deck. If the user has neither 
supplied a subroutine nor used the subroutine 
DAT2 from the Scientific Subroutine Package, the 
following is suggested: 

DAT2. . 

PROCEDURE,. 
RETURN, . 
END,. 

If no errors are detected in the processing of 
data, the error indicator, ERROR, is set to zero. 
The following constitute the possible error con- 
ditions that may be detected: 



ERROR=l 



ERROI^2 



number of observations less than 

or equal to zero. 

at least one variance is zero. 



Method: 



Product-moment correlation coefficients are 
computed. 

Mathematical Background: 

This subroutine calculates means, standard devia- 
tions, sums of cross-products of deviations from 
means, and product moment correlation coefficients 
from input data Xy, where i = 1, 2, . . . , n implies 
observations and j = 1, 2 m implies variables. 



Statistics — Correlation and Regression 195 



The following equations are used to calculate 
these statistics: 

Sums of cross-products of deviations: 



S., = 7 /x.. - T. ) /x., - T, \ 

jk ^^ \ n V \^ ) 

n n 

i=l i=l 



• Subroutine ORDK 



(1) 



where j = 1, 2, . . . , m; k = 1, 2, . . . , m 



m 






i=l 



T. = 
] m 



(2) 



(These temporary means T^ are subracted from 
the data in equation (1) to obtain computational 
accuracy. ) 



i:\ 



Means: X. = 



where j = 1, 2, . .. , m 

Correlation coefficients: 

S.. 



(3) 



^Jk=- 



jk 



4% 4' 



(4) 



kk 



where j = 1, 2, . .. , m; k = 1, 2, . .. , m 
Standard deviations: 



3 =Y_JL 



(5) 



where j = 1, 2, . .. , m 



OROR.. 






OR OR 


IC 


/****** 


{.**«*»***««******„*,»*,«**#*„ 


S:A.^X.««««««»«*««««*»#«:»«#« ««***«« 


**/r30R 


2C 


/* 






*/C*iDR 


30 


/* 


TC CONSTRUCT FROM A LARGER I'ATRIX OF CORRELATION CCEFF IC1ENTS*/0R00 


AC 


/* 


A SUBSET MATRIX OF INTERCORP 


ELATIONS AMONG INDEPENDENT VAR- 


s/rpoR 


5C 


/* 


IA?L = S AND a VECTOR OF INTE'' 


COrcELATIONS OF INDEPENDENT 


«/ORDB 


60 


/* 


V0BI46LES W!TM DEPENDENT VAR 


JAPLE. 


*/GPDR 


7C 


/* 






^/r-cof. 


8C 


/****** 


«**#***«»;**.**«*»*« **#****^t»S# 


X'XluAS«-««4««:4*«««l|>]K*S««»r««««««««* 


»i:/r,rC-- 


9C 


PROCECUPE (M,R,NOEP,K,ISAVe,RX.RYU. 


nftDR 


ICC 


DECLARE 




OROR 


lie 




(iSAVEt*) ,1,J,K,L,L1) 




05C = 


12C 




FIXED BINARY, 




OROR 


13C 




ERRG^ EXTERNAL CHARACTERIl), 




CkDR 


I'.C 




(Rl*,*) ,RX(K,K) ,RY{K1) 




OR DP 


15r> 




PI^JftRY FLOAT.. 


/*SINGIE PRECISION VERSION /* 


S*/ORDfi 


160 


/* 


BINARY FLOAT (5?) ,. 


/*DOUBLE PRECISION VERSION /* 


0*/ORDR 


17C 


/* 






*/CPDO 


IBC 


/« 


COPY INTERCORRELSTIONS OF INDEPENDENT VARIABLES WITH 


«/ORDR 


19r 


/* 


DEPENDENT VARIABLE 




*/CRDR 


2CC 


/* 






«-/"ROR 


21C 


EFROP='C',. 




GROR 


22G 


IF M 


LE C 


/* THE NUMBER OF VARIA8LES IS 


*/PRDR 


230 


THEN 


DO,. 


/* LESS THAN OR EQUAL TO ZERO. 


♦ /CRD" 


2«0 




EftROR=M',. 




rfiOR 


250 




GO "^0 FIN, . 




DRDR 


26C 




END,. 




PRDfi 


27C 




DD 1=1 TG K,. 




f-ftOR 


28C 




IF ISAve(K) = NDEP 


/* INVALID K 


"/Cf 0^ 


290 




C« ISAVttK) LF C 




HROR 


3PC 




OR ISAVctK) GT M 




npDR 


31C 




TriEM DCt. 




(IRDK 


32C 




Et'R0R=*3',. 




CROR 


33C 




GO TC FINt. 




CROP 


34C 




END,. 




OROR 


35C 




END,. 




GRDR 


36C 


IF NDEP LP GP NOEP GT M 


/* INVALID DEPENDENT VARIABLE 


*/CRCP 


37C 


THEN 


DO. . 




OROR 


3P0 




ERR0R='2',. 




ORDR 


39C 




GO TO FIN,. 




CROR 


ACO 




END,. 




OROR 


410 


IF K 


L£ f OR K GE M 


/♦INVALID NUMBER CF INOEPENOE.^IT*/^PDR 


42C 


THEN 


CO,. 


/t VARIABLES 


'VORDR 


430 




EftRCR=»4',. 




OR DP 


4&0 




GU TO FIN,. 




ORDR 


45C 




FND,. 




CROP 


46C 




DO I = I TO K,, 




OROR 


47C 




LI =ISAVEII).. 




OP DP 


48C 




R¥( I )=R(NDEPtLl) ,. 




CRDP 


49 C 


/* 






*/CROP 


5C0 


/* 


CCPY A SUBSET MATRIX OF INTE 


FCCFOHLATIONS AMONG INDEPENDENT 


'/■GPDP 


510 


/* 


VARiaRLES 




e/GRDR 


52C 


/* 






*/CROR 


530 




DC J= I TO K,. 




OROR 


54C 




L2 =ISAVEtJ),. 




OR DO 


55C 




IF L2 LT LI 




ORDR 


560 




THEN RX(I,J)=RX( J,It,. 




OROR 


570 




ELSE RXn,Jl=RtLl,L?) ,. 




rppn 


58C 




END,. 




ORDR 


590 




END,. 




ORDR 


6CC 


/* 






♦ /f^fiDR 


610 


/* 


PLACE THE SUBSCMP-' NUMBER 


F THE DEPENDENT VA0IA3LE 


*/CRCR 


620 


/* 


IN ISAVE(K+l) 




"/OFD" 


630 


/* 






f/nRDR 


640 


ISAVE(I<;+1)=NDEP,. 




ORDR 


650 


FIN.. 






ORDR 


660 


RETURN,. 




POOR 


670 


ENO, 




-'*END OF PPOCEOUPE 09D° 


*/niOP 


680 



Purpose: 

ORDR is used to choose a dependent variable and a 
set of independent variables from a matrix of corre- 
lation coefficients, and form a submatrix of correla- 
tion coefficients to be used in performing a multiple 
linear regression analysis. 

Usage: 

CALL ORDR (M, R, NDEP, K, ISAVE, RX, RY); 

Description of parameters: 

M - BINARY FIXED 

Given number of variables. 

R(M, M) - BINARY FLOAT [(53)] 

Given matrix containing correlation 
coefficients. 

NDEP - BINARY FIXED 

Given subscript number of the de- 
pendent variable. 
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K 



ISAVE ■ 
(K+1) 



RX(K,K) 



RY(K) - 



Remarks: 



BINARY FIXED 

Given number of independent variables 
to be included in the forthcoming 
regression. 
BINARY FIXED 

Given vector containing, in ascending 
order, the subscript numbers of K 
independent variables to be included 
in the forthcoming regression. Upon 
returning to the calling program, this 
vector contains, in addition, the sub- 
script number of the dependent variable 
in K+1 position. 
BINARY FLOAT [(53)] 
Resultant matrix containing intercor- 
relations among independent variables 
to be used in forthcoming regression. 
BINARY FLOAT [(53)] 
Resultant vector containing intercor- 
relations of independent variables 
with dependent variables. 



• Subroutine MLTR 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR=l - number of variables less than or 
equal to zero. 

invalid dependent variable subscript, 
invalid independent variable sub- 
script. If this condition exists, 
RX and RY will contain invalid 
values. 

invalid nimiber of independent 
variables. 



ERROR=2 
ERROR=3 



ERR0R=4 



Method: 

From the subscript numbers of the variables to be 
included in the forthcoming regression, the pro- 
cedure constructs the matrix RX and the vector RY. 



MLTR.. 






MLTR 10 


/************«***«***«******«**«**««****««*****«******«**««««*********/HLTR 20 1 


/• 






•/MLTR 30 


/• 


TO PERFORM A MULTIPLE LINEAR 


REGRESSION ANALYSIS FOR A 


•/MLTR *0 


/* 


DEPENDENT VARIABLE AND A SET 


OF INDEPENDENT VARIABLES. 


•/MLTR 50 


/« 






•/MLTR 60 


/»»*»«*♦♦»***♦**»•*♦♦•*•«*»•••»••**«•»**•♦♦*«♦*♦♦•»♦♦**•**•••*♦•**•♦ 


**/HLTR 70 


PROCEDURE (N.K.XBAR.STO,O.RX,RY,ISAVE.BfSB.T,BETAfANS)i. 


MLTR 80 


DECLARE 




MLTR 90 




ERROR EXTERNAL CHARACTER (11 




MLTR 100 




(IfIO.JiH,MM,MP,HQ.N,Nl,ISAVE(*t) 


HLTR 110 




FIX6D BINARY, 




MLTR 120 




CXBAR(*),STO(*t,D(*>,RX(*,*» 


RY(*),B(*),S8(*1,T(*),BETAI»), 


HLTR 130 




ANS(10),RH,B0,SSARtSSDR*FKtFNN,SY,SSARM,SS0RM,F) 


MLTR 140 




BINARY FLOAT.. 


/♦SINGLE PRECISION VERSION /•St/MLTR 150 


/* 


BINARY FLOAT (53)*. 


/•DOUBLE PRECISION VERSION /•D*/HLTR 160 | 


/» 






♦/MLTR 170 


ERROR*'0'.. 




MLTR 180 


If K 


LE OR N LE K 


/* THE NUMBER OF VARIABLES IS 


•/MLTR 190 


THEN 


00,. 


/* LESS THAN OR EQUAL TO ZERO 


♦/MLTR 200 




ERR0R=*1*,. 


/« OR THE NO. OF OBSERVATIONS 


♦/MLTR 210 




GO TO SIO*. 


/* IS LESS THAN OR EQUAL TO THEVMLTR 220 | 




END,. 


/♦ THE NUMBER OF VARIABLES 


♦/MLTR 230 


HH 


=K*1,. 




MLTR 240 


FK 


-K,. 




MLTR 250 




00 J - 1 TO K,. 




HLTR 260 




BETA(J)'0.0,. 




MLTR 270 




B(J) =0.0,. 




HLTR 280 




DO I = 1 TO K,, 




MLTR 290 




BETA(JI=BETA1J)+RY(I1«RXII>J),. 


MLTR 300 




END,. 




MLTR 310 




END,. 




MLTR 320 


RM 


-0.0,. 




MLTR 330 


BO 


*0.0,. 




MLTR 340 


LI 


=ISAVE(MH),. 




MLTR 350 


/* 






♦/MLTR 360 


/* 


COEFFICIENT OF DETERMINATION 




♦/MLTR 370 


/* 






♦/HLTR 380 




DO I = 1 TO K,. 




MLTR 390 




RM =RM+BETA(I)*RY{I),, 




HLTR 400 


/* 






♦/HLTR 410 


/* 


TEST ACCURACY OF THE RESULT 




♦/HLTR 420 


/* 






•/MLTR 430 




IF RH LT OR RM GT 1 




HLTR 440 




THEN DO,. 




MLTR 450 




ERR0R='2«,. 


/* INVALID MULTIPLE R 


•/MLTR 460 




GO TO SIO,. 




MLTR 470 




END,. 




HLTR 480 




L =ISAVEII).. 


/* REGRESSION COEFFICIENT 


♦/MLTR 490 




B(I) =BETA(I)*<STDIL1)/ST0ILI),. 


MLTR 500 




BO -BO*BlIl*XflARIL),. 


/* INTERCEPT 


♦/MLTR 510 




END,. 




MLTR 520 


BO 


=XBAR(Lll-BO,. 




MLTR 530 


/• 






♦/MLTR 540 


/* 


SUM OF SQUARES ATTRIBUTED TO 


REGRESSION 


♦/HLTR 550 


/* 






♦/MLTR 560 


SSAR 


=RM*DIL1I,. 




HLTR 570 


IF SSAR GT DILI) 


/* TEST SUM OF SQUARES REDUCED 


♦/MLTR 580 


THEN 


00,, 




MLTR 590 




ERR0R='3',. 


/* REDUCED SUM OF SQUARES 


♦/MLTR 600 




GO TO SIO,. 


/♦ GREATER THAN THE TOTAL 


♦/MLTR 610 




END,. 


/♦ SUM OF SQUARES 


♦/MLTR 620 


RH 


=SC|RT(ABS(RM)),. 


/* MULTIPLE CORRELATION COEFF 


♦/MLTR 630 


/* 






♦/MLTR 640 


/* 


SUM OF SQUARES OF DEVIATIONS 


FROM REGRESSkON 


•/MLTR 650 


/* 






•/MLTR 660 


SSDR 


=D(L1)-SSAR,. 




MLTR 670 


FNtl 


=N-K-1 , . 


/* DEGREES OF FREEDOM 


♦/HLTR 680 


IF FNN LE 0.0 




MLTR 690 


THEN 


00,. 




MLTR 700 




ERROR* 'IS. 


/* SAMPLE SIZE TOO SMALL 


•/HLTR 710 




GO TO SIO,. 




MLTR 720 




END,. 




MLTR 730 


SY 


=SSDR/FNN,- 


/* VARIANCE OF ESTIMATE 


♦/MLTR 740 


/* 






♦/MLTR 750 


/♦ 


SIANDARD DEVIATIONS OF REGRESSION COEFFICIENTS 


•/HLTR 760 


/* 






♦/MLTR 770 




DO J = 1 TO K,. 




HLTR 780 




L =ISAVE(J»,. 




HLTR 790 




SB(J)=SQRT(ABSnRXtJ,J)/DIL)>*SYI),. 


MLTR 800 




T(J) ^-BtJl/SBlJ),. 


/* COMPUTE T-VALUES 


♦/MLTR 810 




END,. 




MLTR 820 


SY 


=SQRT(ABS(SY>I.. 


/* STANDARD ERROR OF ESTIMATE 


♦/HLTR 830 


SSARH=SSAR/FK,. 


/♦ F-VALUE 


♦/MLTR 840 


SSDRM=SSOR/FNN,, 




MLTR 850 


F 


=SSARM/SSORM,. 




MLTR 860 


ANS(1)=B0.. 




HLTR 870 


ANS(2)=RM.. 




HLTR 860 


ANSI3I=SY.. 




MLTR 890 


ANSl*)=SSAR,. 




HLTR 900 


ANS(5)=FK,. 




HLTR 910 


ANS(6)=SSARM,. 




MLTR 920 


ANS(7)=$SDR,. 




MLTR 930 


ANS(8)=FNN,. 




HLTR 940 


ANS(9>=^SSDRM.. 




MLTR 950 


ANS(10I=F,. 




MLTR 960 


SIO.. 






HLTR 970 


RETURN,. 




HLTR 980 


END 


• 


/*ENO OF PROCEDURE MLTR 


♦/HLTR 990 



Purpose: 

MLTR performs a multiple linear regression analysis 
for a dependent variable and a set of independent 
variables. 
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Usage: 

CALL MLTR (N, K, XBAR, STD, D, RX, RY, 
IS AVE, B, SB, T, BETA, ANS); 

Description of parameters: 

N - BINARY FIXED 

Given number of observations (N must 
be greater than K). 

K - BINARY FIXED 

Given number of independent variables 
in this regression. 

XBAR(M) - BINARY FLOAT C(53)] 

Given vector containing means of all 
variables, M is the number of 
variables in an observation. 

STD(M) - BINARY FLOAT [(53)] 

Given vector containing standard de- 
viations of all variables. 

D(M) - BINARY FLOAT [(53)] 

Given vector containing the diagonal 
of the matrix of sums of cross- 
products of deviations from means 
for all variables. 

RX(K,K) - BINARY FLOAT [(53)] 

Given matrix containing the inverse 
of intercorrelations among inde- 
pendent variables. 

RY(K) - BINARY FLOAT [(53)] 

Given vector containing intercorrela- 
tions of independent variables with 
dependent variable. 

ISAVE - BINARY FIXED 

(K+1) Given vector containing subscripts 

of independent variables in ascending 
order. The subscript of the dependent 
variable is stored in the last, K+1, 
position. 

B(K) - BINARY FLOAT [(53)] 

Resultant vector containing regression 
coefficients. 

SB(K) - BINARY FLOAT [(53)] 

Resultant vector containing standard 
deviations of regression coefficients. 

T(K) - BINARY FLOAT [(53)] 

Resultant vector containing T values. 

BETA(K) - BINARY FLOAT [(53)] 

Resultant vector containing beta 
coefficients. 

ANS(IO) - BINARY FLOAT [(53)] 

Resultant vector containing the 
following information: 

ANS(l) Intercept 
ANS(2) Multiple correlation 
coefficient 



ANS(3) 
ANS(4) 

ANS(5) 

ANS(6) 
ANS(7) 



ANS(8) 

ANS(9) 
ANS(IO) 



Standard error of estimate 
Sum of squares attributable 
to regression (SSAR) 
Degrees of freedom asso- 
ciated with SSAR 
Mean square of SSAR 
Sum of squares of de- 
viations from regression 
(SSDR) 

Degrees of freedom asso- 
ciated with SSDR 
Mean square of SSDR 
F value 



Remarks: 



If there are no errors in the processing of data, the 
error indicator, ERROR, is set to zero. The fol- 
lowing constitute the possible error conditions that 
may be detected: 



ERROI^l 



ERROR=2 - 



ERR0RF3 



Method: 



number of independent variables K 
less than or equal to zero or the 
number of observations N is less 
than or equal to K. 
coefficient of determination (RM) 
less than zero or greater than one. 
reduced sum of squares (SSAR) 
greater than the total sum of 
squares. 



The Gauss-Jordan method is used in the solution of 
the normal equations. Refer to W. W. Cooley and 
P. R. Lohnes, Multivariate Procedures for the 
Behavioral Sciences . John Wiley and Sons, 1962, 
Chapter 3, and B. Ostle, Statistics in Research , 
The Iowa State College Press, 1954 Chapter 8. 

Mathematical Background: 

This subroutine performs a multiple regression 
analysis for a dependent variable and a set of inde- 
pendent variables. 

Beta weigjits are calculated using the following 
equation: 



^rZ 



r, . r.. 



(1) 



i=l 



where: 



^iy 



intercorrelation of i-th independent 
variable with dependent variable 
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r,. = the inverse of intercorrelation r,. 
i] i] 

i, j = 1, 2, . . . , k imply independent variables 

r. and r.. are input to this subroutine. 

Then the regression coefficients are calculated as 
follows: 



b. = iS. . -L 
J J s. 
3 



(2) 



where: 



s = standard deviation of dependent variable 

s. = standard deviation of j-th independent 

variable 

j = 1, 2, . . . , k 

s and s. are input to this subroutine, 
y ] 



The intercept is found by the following equation: 
k 






(3) 



where: 



Y = mean of dependent variable 

X. = mean of j independent variable 

Y and X. are input to this subroutine 

Multiple correlation coefficient, R, is found first 
by calculating the coefficient of determination by the 
following equation: 



R 



^E".- 



ly 



(4) 



i=l 



and taking the square root of R 



R= ^R 



(5) 



The sum of squares attributable to the regression 
is found by: 



where: 

D = sum of squares of deviations from 
^^ mean for dependent variable 

D is input to this subroutine. 

yy 

The sum of squares of deviations from the re- 
gression is obtained by: 

SSDR = D - SSAR (7) 

yy 

Then, the F value for the analysis of variance is 
calculated as follows: 



F = 



SSARA SSAR(n-k-l) 



SSDR/(n-k-l) SSDR{k) 

Certain other statistics are calculated as follows 
Variance and standard error of estimate: 
„2 SSDR 



(8) 



y. 12. ..k n-k-1 
where n = number of observations 



(9) 



V^ 



y. 12..,k V y.l2...k 
Standard deviations of regression coefficients 



(10) 




y.l2...k 



where D.. = sum of squares of deviations from 
mean for j"^ independent variable. 

D.. is input to this subroutine. 
]] 
j — 1» 2, . . . , k 

Computed t: 

b. 



(11) 



t =-J- 



(12) 



] 



j = l, 2 k 



SSAR = R . D 



yy 



(6) 
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• Subroutine STRG 



STRG.. 




STRG 10 


/••*•** 


f******************m*******************v*****t>*****:*«t:*****«***/SlRG 20 1 


/* 




*/STRG 30 


/* 


TO PERFORM A STEP-WISE MULTIPLE REGRESSION ANALYSIS FOR A 


♦/STRG 40 


/* 


DEPENDENT VARIABLE AND A SET OF INDEPENDENT VARIABLES. 


•/STRG 50 


/* 




*/STRG 60 


/««*«** 


**«****«***«:««***«#«»«««*»«*«***«*«*******«***«*««»*«*««******«/3TRG 70 1 


PROCEDURE 1M,N,D,X6AR,10X,PCT,NSTEP,ANS,L,B,ST0),. 


STRG 80 


DECLARE 


STRG 90 




{l,IO,IJ,lK»J,K,KK,M,MK,MX,My,N,NEW,NFOtNZ,NSTEP(*f,IDX(*) 


STRG 100 




L(*).LL(M)) 


STRG 110 




FIXED BINARY, 


STRG 120 




(D(*,*l ,XBARi*),ANSl*),B(*),STO(*),T{M),S(M),BETAtH),RE) 


STRG 130 




BINARY FLGAT, /*SINGLE PRECISION VERSION 


/♦S^/STRG 140 


/* 


BINARY FLUAT (53), /♦DOUBLE PRECISION VERSION 


/*D^/STRG 150 




IPCT.ONM.RD) 


STRG 160 




FLOAT BINARY, 


STRG 170 




(ERROR, NSTOP) EXTERNAL CHARACTER (1),. 


STRG 180 


/* 




♦/STRG 190 


ERROR='0',. /* INITIALIZATION 


•/STRG 200 


IF M 


LE 1 OR N LE M+1 /* THE NUMBER OF VARIABLES M 


IS^/STRG 210 


THEN 


00,. /« NOT GREATER THAN 1 GR THE 


•/STRG 220 




£RROR='l',. /* NUMBER OF OBSERVATIONS N 


IS ♦/STRG 230 




GO TO S150.. /* NOT GREATER THAN M+1 


•/STRG 240 




END,. 


STRG 250 


IF PCT G£ 1.0 


STRG 260 


THEN 


00,. 


STRG 270 




ERR0R=*4',. /* SPECIFIED CONSTANT IS 


♦/STRG 280 




GO TO S150,. /• GREATER THAN OR = l.O 


•/STRG 290 




END,. 


STRG 300 


ONH 


=N-L,. 


STRG 310 


NFO 


=0,. 


STRG 320 


NSIEP13)=0,. 


STRG 330 


ANS(3)=0,. 


STRG 340 


ANS141=0,. 


STRG 350 


NSTOP='0',. 


STRG 360 






♦/STRG 370 




FIND DEPENDENT VARIABLE, NUMBER OF VARIABLES TO BE FORCED 


TO •/STRG 380 




ENTER IN THE REGRESSION, AND THE NUMBER OF VARIABLES TO BE 


•/STRG 390 




DELETED 


♦/STRG 400 






♦/STRG 410 




DO I = 1 TO M,. 


STRG 420 




LLin = l,. 


STRG 430 




IF lOX(I) LE 


STRG 440 




THEN GO TO SIO,. 


STRG 450 




IF IDX(I) LT 2 


STRG 460 




THEN DO,. 


STRG 470 




NFO =NFC*1,. 


STRG 480 




IDX(NFO)=l,. 


STRG 490 




GO TO SIO,. 


STRG 500 




END,. 


STRG 510 




ELSE IF IDX(I)= 2 


STRG 520 




THEN DO,. 


STRG 530 




NSTEP(31=NSTEP(3)+1,. 


STRG 540 




LL( I )=-!,. 


STRG 550 




GO TO SIC. 


STRG 560 




END,. 


STKG 570 




MY =!,. 


STRG 580 




NSTEP(1)=MY,. 


STRG 5^0 




ANS(51=DtHY,MY),. 


STftC 600 


SIO.. 




STRG 610 




END*. 


STRG 620 


NSTEP(2)=NF0,. 


STRG 630 


/* 




♦/STRG 640 


/* 


FIND THE MAXIMUM NUMBER OF STEPS 


♦/STRG 650 


/* 




•/STRG 660 


MX 


=M-NSTEP(3)-l,. 


STRG 670 


/* 




•/STRG 680 


/* 


START SELECTION OF VARIABLES 


•/STRG 690 


/* 




•/STRG 700 




DO NZ = 1 TO MX,, 


STRG 710 




IF N-NZ-1 LE 


STRG 720 




THEN DO,. 


STRG 730 




ERR0R=«3',. /* DEGREES OF FREEDOM IS 


•/STRG 740 




GO TO S150,. 


STRG 750 




END,. 


STRG 760 




RD =0,. 


STRG 770 




IF NZ GT NFO 


STRG 780 


/* 




•/STRG 790 


/* 


SELECT NEXT VARIABLE TO ENTER AMONG FORCED VARIABLES 


♦/STRG 800 


/* 




•/STRG 810 




THEN GO TO S20,. 


STRG 820 




DO I = 1 TO NFO,. 


STRG 830 




K =IDX(I),. 


STRG 840 




IF LL(K» GT 


STRG 850 




THEN DO,. 


STRG 860 




RE =DIK,HY)**2/0(K,K),. 


STRG 870 




IF RD LT RE 


STRG 880 




THEN DO,, 


STRG 890 




RD =RE,. 


STRG 900 




NEW =K,. 


STRG 9i0 




END,. 


STRG 920 




END,. 


STRG 930 




END,. 


STRG 940 




GO TO S25,. 


STRG 950 


/* 




♦/STRG 960 


/• 


SELECT NEXT VARIABLE TO ENTER AMONG NON-FORCED VARIABLES 


•/STRG 970 


/* 




♦/STRG 980 


S20.. 




STRG 990 




DO I = I TO H,. 


SIRGIOOO 




IF I NE MY 


STRGIOIO 




THEN DO,. 


STRG1020 




IF LUI) GT 


STRG1030 




THEN DO,. 


STRG 1040 




RE =D(I,MY)«*2/D(I,I),. 


STRG1050 




IF RD LT RE 


STRG1060 




THEN DO,. 


STRG1070 




RD =RE,. 


STRG1080 




NEW =1,. 


STRG1090 




END,. 


STRGIIOO 




END,. 


STRGlllO 




END,. 


STRG1120 




END,. 


STRGllSO 


S25.. 




STRG1140 




IF RD LE OR ANSIS! LE ANS(3I+RD 


STRG1150 




THEN DO.. 


STRG1160 




ERR0R='2',. /* NEGATIVE SUM OF SQUARES 


•/STRG1170 




GO TO S150,. 


STRGllSO 




END,. 


STRG1190 




RE =R0/ANS15),. 


STRG1200 


/* 




•/STRG1210 


/» 


TEST WHETHER THE PROPORTION OF THE SUM OF SQUARES REDUCED 


BY ♦/STRG1220 


/* 


THE LAST VARIABLE ENTERED IS GREATER THAN OR EQUAL TO THE 


•/STR61230 



/* 


SPECIFieO PROPORTION 






♦/5TRG1240 


/♦ 


iF RE LT PCT 
THEN GO TO S150,. 






♦/STRG1250 
STRG1260 
STRG1270 




LLINEH)=0,. /* IT IS 


GREATER THAN OR EQUAL 


♦/STRG1280 




L(NZ)=NEW,. 






STRG1290 




ANSIU=RD,. 






STRG1300 




ANS(2)=RE.. 






STRG 1310 




ANS{3)=ANS(3)+RD,. 






STRG1320 




ANS(4)=ANS(4)+RE,. 






STRG1330 




NSTEP(4)=NZ,. 






STRG1340 




NSTEP151=NEW,. 






STRG1350 


/• 








•/STRG1360 


/• 


COMPUTE MULTIPLE CORRELATION, F-VALUE 


FOR 


ANALYSIS OF 


•/STRG1370 


/♦ 


VARIANCE, AND STANDARD ERROR OF ESTIMATE 




♦/STRG1380 


/♦ 


ANS(6)=SQRT(ANS(4)),. 

RD =NZ,. 

RE =ONM-RO,. 

RE =tANS(5)-'ANS(3))/RE,. 

ANS(7»=IANS(3I/RD)/RE,. 

ANS(81=SQRT(REJ.. 






•/STRG1390 
STRG1400 
STRG1410 
STRG1420 
STRG1430 
STRG1440 
STRG1450 


/* 








•/STRG1460 


/♦ 


DIVIDE BY THE PIVOTAL ELEMENT 






♦/STRG1470 


/• 


RD =OtNEM,NEHI,. 

00 J = I TO «,. 
IF LL(J1 LT 
THEN GO TO S40.. 
ELSE IF LL(J> GT 
THEN GO TO S30t. 
IF J = NEW 
THEN DO,. 

0(NEV(,N£W) = 1/R0,, 

GO TO S40,. 

END,. 
D(J,J!=0tJ,J)+0(NEH.JI*^2/R0,. 






•/STRG1480 
STRG 1490 
STRG1500 
STRG1510 
STRG1520 
STRG I 530 
STRG 1540 
STRG1550 
STRG 1560 
STRG I 570 
STRG 1580 
STRG 1590 
STRG1600 


S30.. 


OtNEH,J)=D(NEW.J)/RD,. 






STRG1610 
STRG1620 


S40.. 


END.. 






STRG1630 
STRG1640 


/• 








•/STR61650 


/• 


COMPUTE REGRESSION COEFFICIENTS 






•/STRGI660 


/♦ 


B(NZ)=>D(NEH,Hyt.. 
IF NZ GT 1 
THEN (^Ot. 

10 =N2-1,. 

DO J = I TO ID,. 
IJ =NZ-J,. 
KK =L(IJ),. 
B(IJ)=0(KKtMYI,. 

00 K = 1 TO J,. 
IK =NZ-K+I,. 
MK -L(IK)). 






♦/STRG 1670 
STRG 1680 
STRG1690 
STRG1700 
STRGI710 
STRG1720 
STRG1730 
STRG 1740 
STRGI750 
STRG1760 
STRG 1 770 
STRG1780 




B(IJ)=B<IJ)-D<KK,MK)^Bf IK) 




STRG 1790 




END,. 






STRG 1800 




END,. 






STRG1810 




END,. 






STRG1820 




ANSI9)=XBAR(MY),. /* COMPUTE 


NTERCEPT 


♦/STRG I 830 




DO I ^ 1 TO NZ,. 






STRGI840 




KK =L(I),. 






STRGieso 




ANS(9l=ANS<9)-BtI)^X8AR(KK).. 






STRG1860 




S(I) =ANSU)^SQRTtO(KK,KK)l,. 






STRG 1870 




T(I) =6(I)/S(i),. 






STRG1880 




BETA(I)=6(I)*STD1KKI/ST0(HV),, 






STRG1890 




END,. 






STRG1900 


/♦ 








•/STRG1910 


/* 


PERFORM A REDUCTION TO ELIMINATE THE LAST 


VARIABLE ENTERED 


♦/STRG1920 


/♦ 


DO I = 1 TO M,. 
IF LL(I) GT 
THEN 00,. 

DO J = 1 TO H,. 

IF LUJI GE 

THEN DO,. 

IF J NE NEW 






•/STRG1930 
STRG1940 
STRG1950 
STRG 1960 
STRG I 970 
STRG1980 
STRG1990 
STRG2000 




THEN 0(I,J>=DII,J) 


-D(I,NEW)*DINEW.J),. 


STRG2010 




END,. 






STRG2020 




END,. 






STR62030 




0(I,NEW>=D(I,NEW)/t-RD),. 






STRG2040 




END,. 






STRG2050 




END., 






STRG2060 


/♦ 








♦/STRG2070 


/* 


ADJUST STANDARD ERROR OF THE ESTIMATE 


AND 


MULTIPLE 


♦/STRG2080 


/♦ 


CORRELATION COEFFICIENT 






•/STR62090 


/• 


RD =-N-NSTEP(4),. 
RD =ONH/RO.. 

ANS(10!=SQRT(I-(1-ANS16>^*2)*R0),. 
ANSI 11)'=ANSI8)^SQRT(R0).. 

CALL SOUT INSTEP,ANS,L,B.S.T.BETA).. 






•/STRG2100 
STRG2110 
STR62120 
STRG2130 
STRG2140 
STRG2150 


/• 








•/STRG2160 


/♦ 


TEST WHETHER THE STEP-WISE REGRESSION 


HAS 


TERMINATED 


•/STRG2170 


/• 


IN PROCEDURE SOUT. 






•/STRG2180 


/• 


IF NSTOP GT •0- 
THEN GO TO S150,. 
END.. 






•/STRG2190 

STRG2200 
STRG2210 
STRG2220 


S150.. 








STRG2230 


RETURN,. 






STRG2240 


END 


/♦END OF 


PROCEDURE STRG 


•/STRG2250 



Purpose: 

STRG performs a stepwise multiple linear regression 
analysis for a dependent variable and a set of inde- 
pendent variables. 

Usage: 

CALL STRG (M, N, D, XBAR, IDX, PCT, NSTEP, 
ANS, L, B, STD); 



200 Statistics — Correlation and Regression 



Description of parameters: 



M- 



N. 



D(M,M) 



XBAR(M) - 
IDX(M) - 



PCT. 



NSTEP(5) - 



ANS(ll) 



BINARY FIXED 

Given total number of variables in data 
matrix. 

BINARY FIXED 
Given number of observations. 
BINARY FLOAT [(53)] 
Given matrix of sums of cross- 
products of deviations from mean. 
This matrix will be destroyed. 
BINARY FLOAT [(53)] 
Given vector containing the means. 
BINARY FIXED 

Given vector containing the following 
codes: 

- Independent variable available for 

selection. 

1 - independent variable to be forced 

into the regression equation. 

2 - variable not to be considered in 

the regression equation. 

3 - dependent variable. 

This input vector is destroyed. 
BINARY FLOAT 

Given constant value indicating the 
proportion of the total variance to be 
explained by any independent variable. 
Those independent variables that fall 
below this proportion will not enter 
the regression equation. To ensure 
that all variables enter the re- 
gression equation, set PCT>=0. 0. 
BINARY FIXED 

Resultant vector containing the fol- 
lowing information: 

NSTEP(l) - number of the dependent 

variable. 
NSTEP(2) - number of variables 

forced into the regres- 
sion equation. 
NSTEP(3) - number of variables 
deleted from the re- 
gression equation. 
NSTEP(4) - the number of the last 

step. 
NSTEP(5) - the number of the last 

variable entered. 
BINARY FLOAT [(53)] 
Resultant vector containing the fol- 
lowing information for the last step: 

ANS(l) - Sum of squares reduced 

by this step 
ANS(2) - Proportion of total sum 

of squares reduced 



L(K) 



B(K) 



STD(M) - 



Remarks: 



ANS(3) - Cumulative sum of 

squares reduced, up to 
this step 

Cumulative proportion 
of total sum of squares 
reduced 

Sum of squares of the 
dependent variable 
Multiple correlation 
coefficients 
F ratio for sum of 
squares due to regres- 
sion 

Standard error of the 
estimate (residual mean 
square) 

Intercept constant 
Multiple correlation co- 
efficient adjusted for 
degrees of freedom 
BINARY FIXED 
Resultant vector containing the 
independent variables entered in the 
regression. 

K is the number of independent 
variables to the regression equation. 
BINARY FLOAT [(53)] 
Resultant vector containing the 
partial regression coefficients cor- 
responding to the variables in vector 
L. 

BINARY FLOAT [(53)] 
Given vector containing the standard 
deviations. 



ANS(4) - 



ANS(5) - 



ANS(6) 
ANS(7) 



ANS(8) 



ANS(9) - 
ANS(IO) - 



There must be one, and only one, dependent variable 
and at least one independent variable. 

The number of data points must be greater than 
the number of Independent variables plus one. 
Forced variables are entered into the regression 
equation before all other independent variables. 
Within the set of forced variables, the one to be 
chosen first will be the one that explains the greater 
amoxmt of variance. 

Instead of using, as a stopping criterion, a 
proportion of the total variance, some other 
criterion may be added to the output routine. 

If no errors are detected in the processing of 
data, the error indicator, ERROR, is set to zero. 
The following constitute the possible error condi- 
tions that may be detected: 

ERROR=l - number of variables M not greater than 
1, or N not greater than MH. 



Statistics — Correlation and Regression 201 



ERR0ft=2 - reduced sum of squares exceeds total 

sum of squares. 
ERR0R=3 - degrees of freedom is zero, for the 

variable that is currently active. 
ERR0R=4 - specified constant, PCX, is greater 

than or equal to one. 

Subroutines and function subroutines required: 
SOUT, a special output routine that must be pro- 
vided by the user. The routine prints out the 
results of the stepwise regression. An example of 
such a routine may be found in the sample program 
STEP. 

Method: 



where: 



D = 2 (y, - y)^ 



(n = number of observations) 

If p is less than the constant specified by the 
user to limit independent variables, the analysis 
will be terminated without entering the last variable 
selected; otherwise, the following calculations are 
continued: 

The cumulative sum of squares reduced is ob- 
tained by 



The abbreviated Doolittle method is used to (1) 
select variables entering the regression and (2) 
compute regression coefficients. Refer to C. A. 
Bennet and N. L. Franklin, Statistical Analysts in 
Chemistry and the Chemical Industry , John Wiley 
and Sons, 1954, Appendix 6A. 



S = S + S, 
cum cum i 



and the cumulative proportion reduced by 



P = P + p 
cum cum 



(3) 



(4) 



Mathematical Background: 

This subroutine performs a stepwise multiple re- 
gression analysis for a dependent variable and a 
set of independent variables. In each step of the 
regression i=l,2, . . . ,q, where q is the niunber of 
independent variables, the abbreviated Doolittle 
method is used to calculate the following statistics: 
The independent variable entering in the regres- 
sion is selected, first, by computing the amount of 
reduction of sum of squares for each variable: 



C. = 



where: 



]y 



J] 



(1) 



aj4 is initially an element in the sums of cross- 
products of deviations matrix which will be 
modified in successive steps. 

j = 1,2, . . . , q are independent variables (j 4 
variables deleted and variables entered 
before the i-th step) 

y = dependent variable 

and, second, by finding the largest value of Cj. 

Set Sj = Cj to indicate the sum of squares that 
will be reduced in the i-th step. 

The proportion of Sj to the total is obtained by: 



P = 



S. 
1 

D 



(2) 



The multiple correlation coefficient is computed 



by 



■/ 



R = JP 



cum 



(5) 



and adjusted for degrees of freedom by 
= Vl-(1-R^ (n-1) / (n-k) 



R 



where there are k independent variables in the 
regression. 

The F value for analysis of variance is given by 



F = 



S / k 

cum / 



(D-S ) / (n-k-1) 
cum / 



(6) 



The standard error of the estimated y is obtained 
by the use of the formula 



D-S 



cum 



y.l2...i V n-k - 1 
and adjusted by 

s = s V(n-1) / (n-k) 
Then the following is computed: 



2 
a .. 

a.. = a.. + ^ 

J] JJ a.. 



(7) 



(8) 
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where: 

i = variable entered in the i-th step 

j = VI, Vg, . . . iV|_2 are the variables entered 
in the regression before the i-th step, and 



Perform the reduction to eliminate the variable 
entered in i-th step: 

^jk"^jk"^ji%c 
where: 



(15) 



^ik a, 



il 



(9) 



where k = 1,2 m are variables including 

y (k ^ variables deleted or the variable 
entered in the i-th step). 

Regression coefficients are computed by 

b. 



i 



'iy 



^i-l " ^(l-l)y ■ h ^(i-1) i 



(10) 



i = variable entered in i-th step 

j = 1, 2, . . . , m (j ^ variables deleted and 
variables in the regression) 

k = 1, 2, . . . , m (k ^ variables deleted or the 
variable entered in i-th step) 



*ji " ^ji ^ "^i 



^i=^^^i 



(16) 
(17) 



Programming Considerations: 



h-2 " ^(i-2)y " ^^(i-2) i " Vl^(i-2) (i-1) 



etc. 

and the value of the intercept as 
k 







^ ^ " S ^ ""j 



(11) 



where k = number of Independent variables in the 
regression. 

Standardized regression coefficients, beta wei^ts 



S. 



B. = b. 
J J 



(12) 



If the user provides the routine SOUT, the argument 
list must be consistent with the argument list of the 
call statement in subroutine STRG. 

A description of the parameters follows: 



NSTEP(5),ANS(11) 
L(K), B(K) 



S(M) - 



T(M) - 
BETA(M) 



These parameters are the 
same as in STRG, When used 
in SOUT, however, they 
appear as input, 
BINARY FLOAT [(53)] 
Given vector containing 
standard error of regression. 
BINARY FLOAT [(53)] 
Given computed T value. 
BINARY FLOAT [(53)] 
Given beta coefficient. 



where Sj and Sy are standard deviations. 

Standard errors of regression coefficients are 
given by 



s, = ,/a.. • s 



] 



y. 12. 



(13) 



where j = v-,^, v^' • • • - ^i ^^^ variables in the 
regression and t-values as 



t. = 5 



b 
_] 

s. 



(14) 
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• Subroutine CANC 



TO COMPUTE THE CANONICAL COP": ELAT J ONS BETWEEN TWO SETS OF 
VARIABLES, 



PROCEDiJfiE IN,f*; 
OECLiRE 

ERROR EXTERN 
(N[''F(*1 ,1 .Jf 
FIaED BTWARY, 

IPRl*.*).ROOTSl*)tWLAM(*) .CANRI*) ,CH1SQ(*I .COEFR ( *. « 1 , 
CnfFH*,*) ,0ET,6AT,C0N) 

BINARY FLOAT,. /*SINGLE PRECISION VERSION 

/* BINARY FLOAT (53),. /^DOUBLE PRECISION VERSION 



Cflrc 

******/caNC 

*/CANC 
*/CANC 
*/CANC 

*/CAf;c 

*/CANC 
CANC 



CHARACTER (1) , 
LtM,MP,MO,N,M, lEPR) 



/* 



CHECK WHETHER THE NUMBER OF LFFT-HANO VARIABLES IS EOUfL TO 
OR GREATER THAN THAT OF RIGHT-HAND 



THERE ARE NO PIGHT OR LEFT 
HANO VARIABLES. 



MQ,RR,ROOTS,WLAM,CANP,CHISO,NDF,COEFR,COEFLI . 

CANC SO 

CANC ICC 

CANC lie 

CANC 12C 

CANC 130 

CANC l^C 

*/CftNC 150 

*/CANC 160 

*/CANC 17C 

*/CANC 180 

*/CANC 19C 

*/CANC 2C0 

CANC 2ir 

CANC 220 

*/CANC 230 

*/'CANC 2^0 

CANC 250 

CANC 260 

CANC 27C 

CANC 280 

CANC 29C 

CANC 300 

CANC 310 

CANC 32C 

CANC 33C 

CANC 3<^0 

CANC 35C 

CANC 360 

CANC 37C 

CANC 380 

/»S*/CANC 3<)0 

/♦D*/CANC '.CC 

»/CANC 410 

P4HT1TICN INTERCDRRELATIONS AMONG LEFT HAND VARIABLES, fiETWEEN*/CANC 420 
LEFT AND RIGHT HAND VARIABLE?, AND AMONG RIGHT HAND VAF TA6LES*/CANC 430 

*/CANC 44C 



EftROR='0', . 

I ERR =0,. 

IF MP LE UR MC LE 

THEN DO, . 

ERC03=' I' ,. 

GO TG FIN, . 

EN'", . 
IF MP LT MQ 
THEN DO, . 



=MP, . 
MP =M0,. 
MQ =M,. 
ERR0R='2' .. 
END, . 
COPY. . 

BEGIN.. 
DECLARE 

(RlMP.MPl ,TIMP,MQ),A(MQ,MQ),X(MO.MO)) 

BINARY FLOAT,. /*SINGLE PRECISION VERSION 

/* BINARY FnAT(53),. /*OOUBLE PRECISION VERSION 



M =MP*-MOt. 
FM =M»-1,. 
FN =N,. 
IF ERRORS '2' 
THEN 00,. 

IFRR si, 



= MQ+1 TO M,. 
=K+1,. 



= MQ+l TO I 
=L*l,. 



CHANGE LEFT ANO RIGHT HANO 
VARIABLES 



/* RR 22 INTO R 



R(K,L>=RR(It 

END,. 



/* RR 21 INTO COEFL 



DO J = I TO MQ,, 
CQEFL{K,J1=RR(I, 
END,. 



CANC 45C 
CANC 460 
CANC 470 
CANC 490 
CANC 490 
CANC 500 

*/CANC 51C 

*/CfiNC 520 
CANC 530 
CANC 540 
CANC 550 
CANC 560 

*/CANC 570 
CANC 580 
CANC 590 

♦/CANC 600 
CANC 610 
CANC 620 
CANC 630 
CANC 640 





DO I = I 


TO MQ,. 






CANC 650 




00 J 


= 1 TO MO,. 






CANC 660 






/* RR 11 


INTO 


COEFR 


*/CANC 6f0 




CDEFR(I,J1=RR(I,J),. 






CANC 680 




END, 








CANC 690 




END, , 








CANC 700 




END, . 








CANC 710 


ELSE 


DO,. 








CANC 720 




00 I = I 


TO M,. 






CANC 730 




DO J 


= 1 TO M,. 






CANC 740 




IF 1 


LE MP AND J LE MP 






CANC 750 




THEN 


DO,. 






CANC 760 






/* RR 11 


INTO 


R 


•/CANC 770 






RtI,Jl=RR(l,J),. 






CANC 780 






GO TO SIO,. 






CANC 790 






END,. 






CANC 800 




IF I 


LE MP AND J GT MP 






CANC 810 




THEN 


DO,, 

K =J-MP,. 






CANC 820 
CANC 830 






/* RR 12 


INTO 


COEFL 


«/CANC 840 






CO£FL(I,K)=RF(I,J),. 






CANC 850 






GO TO SIO,. 






CANC 860 






END,. 






CANC 870 




IF I 


GT MP AND J GT MP 






CANC 880 




THEN 


DO,, 

L =1-MP,. 

K =J-MP,. 






CANC 890 
CANC 900 
CANC 910 






/* RR 22 


INTO 


COEFR 


•/CANC 920 






COEfRtL,K)=PB(I,J»,. 






CANC 930 






END,. 






CANC 940 


SIC. 


END, 
END, . 








CANC 950 
CANC 960 
CANC 970 


/* 










•/CANC 980 


/* 


SOLVE THE CANONICAL EQUATION 






♦/CANC 990 


/* 


CON =e,. 








•/CANCtOOO 
CANCIOIO 




CALL MINV (R,MP,OET,CONJ,, 






CANC 1020 




IF ERROR NE T 


I 






CANC1030 




THEN DO,. 








CANCI040 




EKFrp=»3' 








CANC1050 




GC TO F!^ 








CANC 1 060 




END, . 








CANC 1070 


/* 










•/CANC1080 


/* 


CALCULATE T = 


INVERSE OF Rc 11 * RR 12 






•/CANC1090 


/* 










•/CANCllOO 




DO I = 1 


TO MP,. 






CANClllO 




DO J 


= 1 TO MC. 






CANC 1120 




TU, 


J)=0.0,. 

00 J( = 1 TO MP,. 






CANC 1130 
CANC 1140 






T(I,J)=T( I,J1+P|I,K)*C0EFLIK 


J},. 


CANC1150 






END,. 






CANC 1160 




END, 








CANC1170 




END,. 








CANC1180 


/* 










•/CANC1190 


/* 


CALCULATE A = 


RR 21 « T 






•/C4NC1200 


/* 










•/CANC1210 





00 I = I TO MO,. 






CANC1220 




DO J = 1 TO MQ,. 






CANC123C 




A(I ,J)=0.0,. 






CANC1240 




00 K = 1 TO MP,. 






CANCi250 




A(l,J»=A(I,J|tCOEFL(K,I)*T(K,J»,. 






CANC126C 




END,. 






CANC1270 




END,. 






CANC1280 




END, . 






CANC1290 


/s 








•/CANC130C 


/* 


CaLCULtTE EIGENVALUES WITH ASSOCIATED EIGENVECTORS OF 1 


HE 


•/CANC1310 


/* 


INVF>JSE OF P 22 * A 






•/CANC1320 


/* 


CALL MGDU (MO, A, COEFR, ROOTS, X),, 
IF ERROR NE *C' 
THEN DO,. 






•/CANC1330 
CANC1340 
CANC135C 

CANC1360 




ERR0i;='4S. /* ERROR CONDITION 


IN ROUTINE 


*/CANCt370 




GC TC FIN,. /* MSDU. 






•/CANC1380 




END, . 






CANC1390 




IF lE^k;: '1* 






CANC1400 




THEN EPI:QF = '2*,. 






CANC141C 


/* 








•/CANC1420 


/f 


TEST WHETHER EIGENVALUES ARE GREATER THAN 0.0 BUT 


LESS 


THAN 


*/CANCi430 


/* 


l.C 






•/CANC144C 


/* 


DO I = I TO MQ,. 

IF ROOTStI) LE <>.'::■ OR ROOTSfn GE 1.0 

THEN 00, . 






•/CANC1450 
CANC 1460 
CANC 1470 
CANC1480 




ERR0R='5',. /* CANONICAL CORRELATION 


CANN0T*/CANC149C ] 




GO TC FIN,. /* BE COMPUTED 






•/CANC15C0 




END,. 






CANC1510 




END, . 






CANC1520 


/* 








♦/CANC1530 


/* 


FDR EACH VALUE OF 1 = 1,2,. ..,MQ CALCULATE THE STATISTICS 


•/CANC 1540 


/* 


NOTED BELOW. 






•/CANC1550 


/* 


00 I = 1 TO MQ,. 






•/CANC 1560 
CANC 1570 




/• CANONICAL CORRELATION 




•/CANC1580 




CANR(I)=SQRT(ROOTS(I)),. 






CANC159P 




WLAMm = l.C,. 






CANC1600 




00 J = I TO MC. 






CANC1610 




WLAMUl^WLAMl !)*( 1 , C-POOTS IJ ) 1,. 






CANC1620 




END,. 






CANC1630 




BAT =«LAMII),. /• CHI-SOUABE 






*/CANC1640 




CHISQin*-lFN-0.5*FMI*LCG(eAT)T. 






CANC1650 


/* 








•/CANC1660 


/• 


CALCULATE DEGFEES OF FREEDOM FOR CHI-SQUARE 






*/CANCl670 


/* 


Nl =1-1,. 
N0F{I)=(MP-N1)*1MQ-NI),. 






•/CANC16B0 
CAMC1690 
CANCITOC 


/« 








•/CANC171C 


/« 


I-TH SET OF RIGHT HAND COEFICIENTS 






•/CANC1720 


/« 


DO J = 1 TO MQ,. 
COEFRlJ,n=X( J,I),. 

END,. 






•/CANC173C 
rANC1740 
CANC1750 
CANC1760 


/* 








•/CANC1770 


/• 


I-TH SET OF LEFT HAND COEFFICIENTS 






•/CANC178C 


/* 


00 J = 1 TO MP,. 
DET =C.C,. 

DO K. = 1 TO WC. 
DET =0ET+T(J,K1*C0EFR(K,I),. 
END,. 
COEFHJ,l)=DET/CaNRin,. 
END,. 
END,. 
ENO,. 
END,. 






•/CANC179C 
CANC1800 
CANC1810 
CANC1820 
CANC183G 
CANC184C 
CANCieSO 
CANC 1860 
CANC1870 
CANC188C 
CANC1890 


Fih 


RETURN, . 






CANC 1900 
CANC191C 




END,. /*END OF PROCEDURE 


CANC 




•/CANC1920 



Purpose: 

CANC computes the canonical correlations between 
two sets of variables. It is normally preceded by a 
call to procedure CORR. 

Usage: 

CALL CANC (N, MP, MQ, RR, ROOTS, WLAM, 
CANR, CHISQ, NDF, COEFR, COEFL); 

Description of parameters: 



N- 



MP 



MQ 



RR(M, M) - 



BINARY FIXED 

Given number of observations. 

BINARY FIXED 

Given number of left hand 

variables. 

BINARY FKED 

Given number of right hand 

variables. 

BINARY FLOAT [(53)] 

Given matrix (where M=MPfMQ), 

containing correlation coefficients. 
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ROOTS(MQ) - BINARY FLOAT [(53)] 

Resultant vector containing eigen- 
values computed in the subroutine 
MGDU, 

WLAM(MQ) - BINARY FLOAT [(53)] 

Resultant vector of length MQ 
containing lambda. 

CANR(MQ) - BINARY FLOAT [(53)] 

Resultant vector containing 
canonical correlations. 

CraSQ(MQ) - BINARY FLOAT [(53)] 

Resultant vector containing the 
values of chi-squares. 

NDF - BINARY FIXED 

Resultant variable containing the 
number of degrees of freedom, 

COEFR - BINARY FLOAT [(53)] 

(MQ, MQ) Resultant matrix containing MQ 

sets of ri^t-hand coefficients 
columnwise. 

COEFL - BINARY FLOAT [(53)] 

(MP, MQ) Resultant matrix containing MQ 

sets of left-hand coefficients 
columnwise. 

Remarks: 



Method: 

Refer to W. W. Cooley and P. R. Lohnes Multivariate 
Procedures for the Behavioral Sciences , John Wiley 
and Sons, 1962, Chapter 3. 

Mathematical Background: 

This subroutine performs a canonical correlation 
analysis between two sets of variables. 

The matrix of intercorrelations, R, is parti- 
tioned into four submatrices: 



R 



\l 


^2l 


hi 


^22j 



(1) 



R = intercorrelations among p variables in 

the first set (that is, left-hand variables) 



R = intercorrelations between the variables 
in the first and second sets 



R = the transpose of R 



The number of left-hand variables (MP) should be 
greater than or equal to the number of ri^t-hand 
variables (MQ). If the value of MP is less than the 
value of MQ, the input matrix is rearranged to 
satisfy the above conditions. The right-hand vari- 
ables become left-hand variables and left-hand 
variables become ri^t-hand variables. If this 
condition exists, the error code indicator, ERROR, 
is set to 2. 

Also, if the variables are changed, the values of 
MP and MQ are Interchanged. 

If no errors are detected in the processing of 
data, the error Indicator, ERROR, is set to zero. 
The following constitute the possible error conditions 
that may be detected: 

ERROR=l - no ri^t-hand or left-hand variable — 
returned values are meaningless. 

ERROR=2 - number of left-hand variables smaller 

than the number of right-hand variables. 

ERROB=3 - correlation coefficient matrix ill-con- 
ditioned (determined by MINV). 

ERROa=4 - error condition in routine MGDU, from 
MSDU. 

ERROR=5 - Eigenvalues less than or equal to zero 
or greater than or equal to one. 

Subroutines and function subroutines required: 

MINV 

MGDU (which, in turn, calls the subroutine MSDU) 



R = intercorrelations among q variables in 
the second set (that is, right-hand 
variables) 

The equation: 



^22 ^21 ^11 ^12 " ^^ 



= 



(2) 



is then solved for all values of X, eigenvalues in 
the following matrix operation: 



^ = \l h2 



^ = ^1^ 



(3) 



(4) 



The subroutine MGDU calculates eigenvalues 
(Xi), with associated eigenvectors, of R^i A, 
where i= 1, 2, ..., q. 

For each subscript 1=1, 2, . . . , q, the following 
statistics are calculated: 



Canonical correlation: 



CANR = 



(5) 



where Xj = i-th eigenvalue 
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Chi- square: 



Analysis of Variance 



^ = - [n-O.S (p+q+1)] log A 

6 



where n = number of observations 



(6) 



• Subroutine AVAR 



A= n (1-X) 
i = i 



Degrees of freedom for y : 

DF= [p-(i-l)] [q-(i-l)] 
i-th set of right-hand coefficients: 



\=\i 



where v, . = eigenvector associated with X. 
i-th set of left-hand coefficients: 

q 

Z 

k= 1 



(7) 



(8) 



E V \ 



a. = 



CANR 



(9) 



-1 



where 1 1.,_ <, = T = R^^ B.^^ 



j = 1, 2 p 



AVAR.. 




A«.'. 10 ■ 


/****************«4i*««**««*«**«****4'««<^**»««*i«**««**«******««*«******/AVi.n 20 j 


/* 




♦/AVAR 30 


/♦ 


TQ PERFORM AN ANALYSIS OF VAR 


ANCE FOR 1 LU^.fLfcfE FACTORIAL V AVAR 40 


/♦ 


DESIGN. 


• /,.VAR 50 


/♦ 




•/AVAR 60 


/***«*«»«»*****«*«*****«***«*«[***««***«:«»*«******«**«>««*********«***«*/AV P 70 1 


PROCEDURE IK, LEVEL, NtX.GHEAN.SUMSQ 


NOx-,ShEAN).. A'/.'., 80 


DECLARE 


AVAR 90 




ERROR EXTERNAL CHARACTERU). 


AVAR ^00 




(LEVEL(«).NDF(«),KOUNTtKt tISTEPIK),LASTSIKItItlNCRE,JtK,L.LAST,AVAft 110 | 




LL.N.NlfN01tND2.NN,NSIZ) 


AVAR 120 




FIXED BINARY, 


AVAR 130 




(X(*l.SUHSQt*»,SMEAN(*),FSUM. 


SHEAN.FN,FN1.FN2) AVAR 140 




BINARY FLOAT.. 


/♦SINGLE PRECISION VERSION /*S*/AVAR 150 


/• 


8INARY FLOAT (»>.. 


/♦DOUBLE PRECISION VERSION /^O /AVAR 160 


ERROR='0',. 


AVAR 170 


NSIZ 


=I2»*K)-1.. 


AVAR 180 


IF N 


LE 


/♦ THERE ARE NO DATA POINT:, */AVAR 190 


THEN 


D0(. 


AVAR 200 




ERROR- • X ' . . 


AVAR 210 




GO TO FIN,. 


AVAR 220 




END,. 


AVAR 230 


fH 


=-N,. 


AVAR 240 


IF K 


LT 2 


AVAR 250 


THEN 


00,. 


AVAR 260 




ERR0R='2',. 


/* ONE OR LESS FACTORS */AVAR 270 




60 TO FIN,. 


AVAR 280 




END,. 


AVAR 290 




DO I = 1 TO K,. 


AVAR 300 




IF LEVELU) LT 2 


AVAR 310 




THEN DO.. 


AVAR 320 




ERR0R='3»,. 


/* 1 OR MORE LEVELS LESS THEN 2*/AVAR 330 




GO TO FIN,. 


AVAR 340 




END.. 


AVAR 350 




END,. 


AVAR 360 


/• 




♦/AVAR 370 


/• 


CALCULATE MULTIPLIERS TO BE USED IN FINDING STORAGE LOCATIONS*/ AVAR 380 | 


/* 


FOR INPUT DATA. 


♦/AVAR 390 


/♦ 




♦/AVAR 400 


ISTEPll»«l,. 


AVAR 410 




00 I = 2 TO K,. 


AVAR 420 




ISTEPtn = ISTEP(I-l»*tL£VEL(I- 


D-l-ll,. AVAR 430 




ENO,. 


AVAR 440 




00 I » 1 TO K.. 


/♦ SET LEVEL COUNTER ♦/AVAR 450 




KOUNTtI) = LEVeL(n.. 


AVAR 460 




ENO.. 


AVAR 470 


Nl 


-N.. 


AVAR 480 




00 I - I TO N,. 


/♦ PLACE DATA IN PROPER PLACE ♦/AVAR 490 




L =KOUNril),. 


AVAR 500 




DO J = 2 TO K,. 


AVAR 510 




L =.L*ISTEPIJI*(KOUNT(J)-ll,. AVAR 520] 




END,. 


AVAR 530 




XILt =X(N1),. 


AVAR 540 




Nl =in-i,. 


AVAR 550 




DO J = i !0 K,. 


AVAR 560 




IF KOUNT(J) GT I 


AVAR 570 




THEN DO.. 


AVAR 580 




KOiJNT{JI = KOUNTtJ)-l 


,. AVAR 590 




GO TO SlOr. 


AVAR 600 




END,. 


AVAR 610 




KOUNri J)=LEVEL(J).. 


AVAR 620 




tND,. 


AVAR 630 


SIO.. 




AVAR 640 




i-NO,. 


AVAR 650 


L 


=i.EVEL(l) ,. 


/♦ CALCliLATE LAST DATA POSITIONS/AVAR 660 




DO J = 2 TO K,. 


AVAR 670 




L =L*1STEP(JI*(LEVEL(J)~1) 


.. AVM 680 




END,. 


AVAR 690 


/* 




*/AVAR 700 


/* 


CALCULATE THE LAST DATA POSITION OF EACH FACTOR */AVAR 710 [ 


/* 




♦/AVAR 720 1 


LASTSC1)=:L>^1,. 


AVAR 730 




DO I = 2 TO K,. 


AVAR 740 




LASTS(1I=LASTS(I-1»*ISTEP(U, 


AVAR 750 




END,. 


AVAR 760 




00 I = 1 TO K,. 


/• PERFORM OPERATOR CALCULUS ^/AVAR 770 




L =1,. 


AVAR 780 




LL =1.. 


AVAR 790 




FSUM =0.0.. 


AVAR 800 




NN =L£VELII),. 


AVAR 810 




INCRE^i'ISTEPtll*. 


AVAR 820 




LAST =LASTS(I).. 


AVAR 830 


S20.. 




AVAR 840 




00 J - I TO NN,. 


/♦ SIGMA OPERATION ♦/AVAR 850 




FSUM =FSUM*X(L).. 


AVAR 860 




L =L4-INCRE,. 


AVAR 870 




END,. 


AVAR 880 




ML} =FSUM,. 


AVAR 890 




FNl =NN.. 


AVAR 900 




00 J = 1 TO NN,. 


/♦ DELTA OPERATION ♦/AVAR 910 




X1LLI=FN1*X(LL)-FSUM,, 


AVAR 920 




LL =LL*INCRE,. 


AVAR 930 




END.. 


AVAR 940 




FSUM =0,0,. 


AVAR 950 




IF L LT LAST 


AVAR 960 




THEN DO,. 


AVAR 970 




IF L LE LAST-INCRE 


AVAR 980 




THEN 00,. 


AVAR 990 




L =L+1NCRE,. 


AVARIOOO 




LL =LL-*-lNCRE,. 


AVARLOIO 




GO TO S20,. 


AVAR1020 




END,. 


AVAR1030 




L =L+INCRE+1-LAST.. 


AVAR1040 




LL =LL*1NCRE+1-LAST,. 


AVAR1050 




GO TO S20,, 


AVAR 1060 




END,. 


AVAR1070 




END,. 


AVARI080 




DO I = 1 TO NSIZ.. 


AVAR1090 




SUHSQ^O.O,. 


AVARIIOO 




END,. 


AVARlllO 


/* 




♦/AVAR1I20 


/* 


SET UP CONTROL FOR MEAN SQUARE OPERATOR •/AVAR1130 


/* 




♦/AVAR1140 


LASTSU)=L£VEL(1),. 


AVAR1I50 


ISTEPUl-l.. 


AVAR1160 




DO I = 2 TO K,. 


AVAR 11 70 




LASTS(1)=LEVEL(I)+1,. 


AVAR 1160 
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ISTEI>(I1-ISTEPII-11«2,. 










AVAR1190 




END,. 










AVAR1200 


NN 


-1,. 

DO I - 1 TO K,. 

KOUNTID-O.O,. 

ENO,. 










AVAR1210 
AVAR1220 
AVAR1230 
AVAR 1240 


S30.. 












AVAR1250 


1. 


=0,. 

DO 1 - 1 TO K,. 

IF KOUNTIII NE LtSTSIII 

THEN 00,. 

IF L LE 

THEN DO,. 










AVAR1260 
AVAR1270 
AVAR1280 
AVAR 1290 
AVAR 1300 
AVAR1310 




K0UNTIII«K0UNT(I)+1 








AVAR1320 




IF KOUNTIII LE 


LEVELl I) 






AVAR1330 




THEN GO TO S40 


,, 








AVAR1340 




GO TO S50,. 










AVAR1350 




END,. 










AVAR1360 




IF KOUNTIII. LEVELl 


11 








AVAR1370 




THEN GO TO S60,. 










AVAR13eO 


S40.. 


L sL+lSTEP(ll,. 
GO TO S60,. 
END,. 










AVAR 1390 
AVARIMO 
AVAR1410 
AVAR1420 


S50.. 


KOUNTIIJ=0,. 










AVAR1430 
AVAR1440 


S60.. 


END,. 










AVAR1450 
AVAR1A60 


IF L 


GT 










AVAR1470 


THEN 


00,. 










AVAR 1460 




SUHSQai-SUHSO(LI+XINNI*X{NN) 








AVAR 1490 




NN *NN+1,. 










AVAR1500 




GO TO S30,. 










AVAR1510 




END,. 










AVAR1520 


GHE«N-X(NNI/FN,. 




/• CALCULATE HEAN 


*/AVAR1530 


/* 












*/AVAR1540 


/• 


CALCULATE FIRST DIVISOR 


REQUIRED TO 


FORH SUN OF SQUARES AND 


•/AVAR1550 


/* 


DIVISOR. HHICH IS EQUAL 


TO DEGREES 


OF 


FREEDOM, REQUIRED TO 


*/AVAR1560 


/• 


FORH MEAN SOUARES 










•/AVAR1570 


/* 












♦/AVAR1580 


ISTEP«0,. 










AVAR1590 


ISTEPIll-l,. 










AVAR 1600 


NN 


=0.. 










AVAR1610 


S70.. 












AVAR1620 


NDl 


= 1, . 










AVAR 1630 


ND2 


•I,. 

00 I > 1 TO K,. 

IF I STEP! I) NE 

THEN DO,, 

NDl =ND1*LEVEL(I), 
ND2 •ND2»I LEVELl 11 
END,. 

END,. 


-11,. 








AVAR1640 
AVAR16:f0 
AVAR1660 
AVAR1670 
AVAR16S0 
AVAR1690 
AVAR1700 
AVAR1710 


FNl 


=N*ND1,. 










AVAR1720 


FN2 


=ND2,. 










AVAR1730 


NN 


=NN>1,. 










AVAR1740 


SUHSQ(NN)-SUH$Q(NN)/FNlt. 










AVAR1750 


SMEAN(NN)>SUMSQ(NN}/FN2t. 










AVAR1760 


N0FINNI-N02.. 










AVAR1770 


IF NN LT LL 










AVAR1780 


THEN 


DO,. 

DO I = 1 TO K,. 
IF ISTEPII) NE 
THEN ISTEPIIl-O,. 
ELSE DO,. 

ISTEPIII=l,. 

GO TO S70,. 

END,. 
END,. 
END,. 










AVAR1790 
AVAR 1800 
AVAR1810 
AVAR1820 
AVAR1830 
AVAR1840 
AVAR1850 
AVAR1860 
AVAR1870 

AVARieeo 


FIN.. 












AVAR 1890 


RETURN.. 










AVAR1900 


END, 






/*END 


OF 


PROCEDURE AVAR 


*/AVAR19lO 



Purpose: 

AVAR performs an analysis of variance for a com- 
plete factorial design. 

Usage: 

CALL AVAR (K, LEVEL, N, X, GMEAN, SUMSQ, 
NDF, SMEAN); 

Description of parameters: 

K - BINARY FIXED 

Given number of variables (factors). 
LEVEL (K) - BINARY FIXED 

Given vector, the i-th element being 

the number of levels for the i-th 

factor (LEVELi). 
N - BINARY FIXED 

Given total number of data points 

read in (N= [2 **K]-1). 
X - BINARY FLOAT [ (53) ] 

Given vector of length 



GMEAN' 



SUMSQ - 



NDF- 



SMEAN- 



Remarks: 



K 

n (LEVEL 1 + 1) 
1=1 

with data positioned in locations one 

to N, where N is the total number of 

data points read in. The length of the 

vector must not exceed 32, 767. 

BINARY FLOAT [ (53) ] 

Resultant variable containing grand 

mean. 

BINARY FLOAT [ (53) ] 

Resultant vector of length 2 to the 

K^^ power minus one, ( [ 2**K ] - 1), 

containing the sums of squares. 

BINARY FIXED 

Resultant vector of length ( [ 2**K ] 

-1), containing degrees of freedom. 

BINARY FLOAT [ (53) ] 

Resultant vector of length ( [ 2**K ] 

- 1), containing mean squares. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR= 1 - N, the number of data points, less than 

or equal to zero. 
ERR0R=2 - There is only one factoror less than one. 
ERROR= 3 - One or more factors have levels less 

than two. 

Method: 

The method is based on the technique discussed by 
H. O. Hartley in Mathematical Methods for Digital 
Computers , edited by A. Ralston and H. Wilf, John 
Wiley and Sons, 1962, Chapter 20. 

Mathematical Background: 

This procedure calculates an mialysis of variance 
in three steps: 

1. The data is placed in properly distributed 
positions of storage. 

The size of the data array named X required for 
an analysis of variance problem is calcidated as 
follows: 



K 
MM= n (L. + 1) 
i=l ^ 



where: 

Lj = number of levels of i-th factor 
K = number of factors 



(1) 
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The data is redistributed according to equation 
(4) below. Prior to that, multipliers, S-, to be 
used in finding proper positions of storage, are 
calculated as follows: 



S^=l 



J-1 

s. = n (L. + 1) 
J i=i ^ 



(2) 



(3) 



where j = 2, 3, ..., K. 

Then the position to place each data point is 
calculated by the following equation: 



K 



S = KOUNT 



, + Z2 %' (KOUNT. - 1) (4) 

j = 2 J 



where KOUNTj = value of the j-th subscript of the 
data to be stored. The procedure increments tiie 
value(s) of subscript(s) after each data point is 
stored. 

2. The next step performs the calciilus for the 
general K-factor experiment: operator S and 
operator A. An example is presented in terms of 
K = 3 to illustrate these operators. 

Let XgjijQ denote the experimental reading from 
the a-th level of factor A, the b-th level of factor 
B, and the c-th level of factor C. The symbols A, 
B, C will also denote the number of levels for each 

factor so that a = 1, 2, . . . , A; b = 1, 2 B; 

c — i, ^, . . . , o. 

With regard to the factor. A: 

operator S = sum over all levels a = 1, 

^ 2 , . . . , A, holding the other 
subscripts at constant levels, 
operator A= multiply all items by A and 

subtract the result L from all 
items ^ 

In mathematical notations, these operators are 
defined as follows: 



E 



A 



abc . be 



a= 1 



X 



abc 



X, = AX ^ -X ^ 
a abc abc .be 



(5) 



(6) 



3. In the next and final step the mean square 
operation for the general K-factor experiment is 
performed as follows: 

a. Square each value of deviate for analysis of 
variance stored in array X, which is the 
result of the operators S and A applied in 
step 2. 

b. Add the squared value into a proper sum- 
mation storage. In a three-factor experi- 
ment, for example, the squared value is 
added into one of the seven storages 

(7 = 2^ -1) as shown in the first column of 
the following table. The symbols A, B, and 
C in the first column denote factors A, B, 
and C. 
After the mean square operation is completed 
for all values in the storage array X, the procedure 
forms sums of squares of analysis of variance by 
dividing the totals of squared values by the proper 
divisors. These divisors for the three-factor ex- 
periment mentioned above are shown in the middle 
column of the Table. The symbols A, B, and C in 
the second column denote the number of levels for 
each factor. 

The procedure then forms mean squares by 
dividing sums of squares by degrees of freedom. 
The third column of the table shows the degrees of 
freedom. The symbols A, B, and C denote the 
number of levels. 



Designation of store 


Divisor required to 


Degrees of freedom 


and of quantity con- 


form sum of squares 


required to form 


tained in it 


of analysis of variance 


mean squares 


(A)2 


ABC. A 


(A-1) 


(B)2 


ABC. B 


(B-1) 


(AB)2 


ABC. AB 


(A-1) (B-1) 


<C)2 


ABC.C 


(C-1) 


(AC)2 


ABC. AC 


(A-1) (C-1) 


<BC)2 


ABC. BC 


(B-1) (C-1) 


(ABC)2 


ABC. ABC 


(A-1) (B-1) (C-1) 



Programming Considerations: 

Input data must be arranged in the following man- 
ner: Consider the three-variable analysis of vari- 
ance design, where one variable has three levels 
and the other two variables have two levels. The 
data may be represented in the form X(I, J, K). 
The left subscript — namely, I — changes first. 
When 1=3, the next left subscript, J, changes, and 
so on, until 1=3, J=2, and K=2. 



The operators S and A will be applied 
sequentially with regard to all factors A, B, and C. 
Upon the completion of these operators, the stor- 
age array X contains deviates to be used for 
analysis of variance components. 
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Discriminant Analysis 



Usage: 



Subroutine DMTX 



CALL DMTX (K, M, N, X, XBAR, D); 



DMTX.. 














OMTX 


10 


/****** 


**^#****«*«***«*ft****«******^* 


t*« 


««;*#«« 




***** 


{.**«*»«**««« 


**/OMTX 


20 


/* 














*/DMTX 


30 


/* 


TO COMPUTE MEANS OF VARIABLE^ 


IN 


EACH 


SROUP 


AND 


A POOLED 


*/DMTX 


AG 


/* 


DISPERSION MATRIX FOR ALL THt 


CRnuPS. 








*/DMTX 


50 


/* 














*/DMTX 


60 


/****«* 






***** 






**/DMTX 


7C 


PROCEDURF (K,MtN,X,XBflR,0),, 












DMTX 


8C 


t)ECLAPE 












DMTX 


9C 




EK90R EXTERNAL CHARACTER lU 












DMTX 


100 




(N(*).I,J.K,K1,K2,KK,L,M,NN'J 












DMTX 


lie 




FIXED eiNARY, 












OMTX 


120 




(XI*,*), FSUM) 












OMTX 


l?0 




FLOAT BINARV, 












DMTX 


lAC 




IX6AR(*,*J ,D(*,*),CMEAMM) ) 












OMTX 


15C 




eiNARY FLOAT, . 


/« 


iINGLE 


PRECISION 


VERSION /*S*/DMTX 


160 


/* 


PENARY FLOAT (53),. 


/*00U6LE 


PRECISION 


VERSION /* 


D*/DMTX 


170 


/* 














*/OMTX 


180 


ERPOR^'C ,. 












OMTX 


190 


IF M 


LE 1 


/* 


THE NUMBER 


OF VARIABLES IS 


*/DMTX 


200 


THEN 


CO, . 


/* 


LESS 


rHAN 


DB EQUAL TG ONE. 


*/OMTX 


210 




ERRCR='l'.. 












DMTX 


220 




GO TO FIN,. 












DMTX 


230 




END,. 












DMTX 


2«0 


IF K 


Lfc 1 OR K GT M 


/* 


INVALID NUMBER 


DF GROUPS. 


*/OMTX 


250 


THEN 


DC, . 

ERfiOft='2',. 

GO TO FIN,. 

END,. 

DO J = 1 TO K,. 












DMTX 
OMTX 
DMTX 
OMTX 
DMTX 


260 

270 
280 
290 




IF NIJl LE 


1" 


NO OBSERVATIONS 


IN AT LEAST 


*/DMTX 


31C 




THEN 00,. 


/* 


ONE OF THE 


GROUPS 


*/OMTX 


320 




E«flOB='3',. 












DMTX 


33C 




GO TO FIN,. 












DMTX 


340 




END,. 












OMTX 


350 




END,. 












DMTX 


360 




DC I = 1 TO M,. 












DMTX 


370 




DO J = 1 TO K.. 












DMTX 


380 




XBAR(I,JI=O.C,. 












DMTX 


39 C 




END,. 












DMTX 


400 




END,. 












DMTX 


410 




=C,. 












DMTX 


42 C 




DO I = 1 TO K , . 












DMTX 


430 




NN =N(I),. 












OMTX 


440 




fSlIM =NN,. 












DMTX 


450 




00 J = 1 TO NN,. 












DMTX 


46C 




L =L+1,. 












OMTX 


470 




00 KK = 1 TO M,. 












DMTX 


480 




XBAftlKK,I)=XSAR(KK, 


I )+XIL,KK),. 






D"TX 


490 




END,. 












DMTX 


500 




END,. 












OMTX 


510 




DC KK = I TO M,. 












DMTX 


520 




XBAR IKK.n^XBAftiKK.n /FSUM* 










OMTX 


530 




END,. 












DMTX 


540 




END,. 












OMTX 


550 


/* 














*/DMTX 


560 


/* 


Cr*tPUTE THE DISPERSION MATRIX 












•/DMTX 


570 


/* 


DO I = 1 TO M,. 

DO J = 1 TC M,. 
Dn,JI=0.0,. 

END,. 
eNO,. 












♦/OMTX 
DMTX 
DMTX 
DMTX 
DMTX 
DMTX 


580 
590 
600 
610 
620 
630 


L 


=0,. 

DO I = 1 TO K,. 

NN =N(I),. 

DO J = 1 TO NN,. 

L =L*1,. 

DO KK = 1 TO M,. 












DMTX 
OMTX 
DMTX 
OMTX 
DMTX 
DMTX 


640 
650 
660 
670 
680 
690 




CMEAN(KK)=X(L,KK)-XBAR(KK,I) 








OMTX 


700 




END,. 












OMTX 


710 




DO Kl = 1 TO H,. 












DMTX 


720 




00 K2 = Kl TO 


M,. 










OMTX 


730 




D<KI*K2)=0(K1, 


K2I*CMEAN(K1»*CMEANIK2),. 


DMTX 


740 




END,. 












DMTX 


750 




END,. 












DMTX 


760 




END,. 












OMTX 


770 




END, . 












OMTX 


780 


L 


=0,. 

DO KK = 1 TO K,. 

L =L+N(KK),. 

END,. 












DMTX 
OMTX 
OMTX 
OMTX 


790 
800 
810 
820 


FSUM 


=L-K,. 

DO I = 1 TO M.. 

DO J = I TO M,. 

D{I,J»=01I,J)/FSUM,. 

D(J,I)=D(I,J),. 

END.. 
END, . 












OMTX 
DMTX 
DMTX 
DMTX 
OMTX 
DMTX 
OMTX 


830 
840 
850 
860 
870 
880 
890 


FIN.. 














OMTX 


900 


RETURN.. 












OMTX 


910 


END, 




/•END OF 


PROCEDURE 


DMTX 


*/OMTX 


920 



Purpose: 

DMTX computes means of variables in each group 
and a pooled dispersion matrix for all the groups. 
This subroutine is used in the performance of dis- 
criminant analysis. 



K 



M- 



N(K)- 



X(NN, M) 



XBAR(M,K) 



D(M,M) 



Remarks: 



BINARY FIXED 

Given number of groups. K must be 
greater than 1. 
BINARY FIXED 

Given number of variables (must be 
the same for all groups). 
BINARY FIXED 

Given vector containing sample sizes 
of groups. N=(ni, n^, ••• , %) 
BINARY FLOAT 

Given matrix containing data in a 
manner equivalent to a three- 
dimensional array (Xj^j^). The first 
subscript is case number; the second, 
variable number; the third, group 
nimiber. NN=n2 + n2 + . . . + nj^. 
BINARY FLOAT [(53)] 
Resultant matrix containing means of 
variables in K groups. 
BINARY FLOAT [(53)] 
Resultant matrix containing pooled 
dispersion. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERR0R=1 - number of variables less than or equal to 

one, 
ERROR=2 - invalid number of groups (K £ 1 or K > M). 
ERROR=3 - no observations in one or more groups. 

The number of variables must be greater than or 
equal to the number of groups. 

Method: 

Refer to BMP Computer Programs Manual , edited 
by W. J. Dixon, UCLA, 1964, and T. W. Anderson, 
Introduction to Multivariate Statistical Analysis , 
John Wiley and Sons, 1958, Sections 6.6-6.8. 

Mathematical Background: 

This subroutine calculates means of variables in 
each group and a pooled dispersion matrix for the 
set of groups in a discriminant analysis. 

For each group k = 1, 2, . . . , K, the subroutine 
calculates means and simas of cross-products of 
deviations from means as shown below. 
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Means: 



t Subroutine DSCR 



Jk 



i = 1 
\ 



(1) 



,th 



where rxy. = sample size in the k group 
j = 1, 2, ..., m are variables 

Sum of cross-products of deviations from means: 

\ = {^j\}= Z<^ijk-V <^ilk-^k> (2) 

where j = 1, 2, . ., , m 

1 = 1, 2, ..,, m 

The pooled dispersion matrix is calculated as 
follows: 

K „ 



**«*»*»«««: 



**»*«*******«*g 



TO COMPUTE A SET OF LINEAR FUNCTIONS WHICH SERVE AS INDICES 
FOR CLASSIFYING AN INDIVIDUAL INTO ONE OF SEVERAL GROUPS. 

PRGCEOURE (K,M,N,X,XBAR,D,CMEAN,V,CiP,LGl,. 
DECLARE 

(N1*),LG(*),I,J,K,K:1,K2,L,LL,M,NI,NN) 

FIXED EINAPV, 

ERROR EXTERNAL CHARACTER 1 1 ) i 

(X(*.«) ,FN(K)) 

PINARY FLOAT, 

{XBAR(*,»),D(*,*),C(*,*),CMEAN(«) * P(*) , Vt FSUH* PL) 



/•SINGLE PRECISION VERSION 
/♦DOUBLE PRECISION VERSION 



D 



k = 1 



K 



k = 1 
where K = nvimber of groups 



(3) 



/* NUMBER OF VARIABLES LESS 
/* THAN OR EQUAL TO ONE^ 



INVALID NUMBER OF GROUPS. 



/* NO OBSERVATIONS IN ONE OR 
/* MORE GROUPS. 



B!N£BY FLOAT, . 
BINARY FLOAT (53) ,. 



FRftOR='0S . 
IF H LE I 
THEN DO, . 

ERROR=' !■ ,. 

GO TO F IN, . 

END, . 
IF K LE 1 OR K GT M 
THEN no, . 

eRR0R='2' ,. 

GO ■^O FIN, . 

END, . 

DO I = 1 TO K,, 

IF N( I) LE 

THEN DO,. 

ERR0R='3',. 
GO TO FIW, , 
END, . 

END,. 

on I = 1 TO K,. 

L =L*N(n,. 

END, . 
FSUM =L. . 

DG I = I TO M,. 

V =0.0,. 

DP J = 1 TO K,. 

V =v*N( j»*xeARn,j), 

ENP,. 
CMEAN(I»=V/FSUM,. 
END, . 



CALCULATE GENERALIZED MAHALAMOBIS SQUARE 

=0,. 

DO I = 1 TO M,. 

DO J = 1 TO M,. 
FSUM =0.0,. 

00 KK = I TO K,. 

FSUM =FSUM4-NIKK)*1X8AR1I,KK)-CMEAN(I)) 

*(X6ARIJ,KK)-CMEAN( J)),. 
END,. 
V =VtD(I,J)*FSUH,. 

END,. 
END,. 

CALCULATE THE COEFFICIENTS <^F DISCRIMINANT FUNCTIONS 

00 I = 1 TO K,. 
FSUM =0,. 

00 J = 1 TO M,. 

00 KK = 1 TO M,. 

FSUM sFSUM+Df J,KK)*X6ARlJ,n*XBAR(KK,n,. 
END,. 
END, . 
C(1,I»=-{FSUM/21,. 

DO J = 1 TO M, , 
C1J*1, I )=0.0,. 

00 KK = 1 TU M,. 

C(J*1,I)=C( Jt 1,I)+D( J,KK)*XSARIKK,I),. 
END, . 
END.. 
END,. 



DO I = I TO K,. 
NN =N(I),. 

00 J = 1 TO NN,. 
L =L+1,. 

00 KI = 1 TO K,. 
FN(KU=C(l,Kl),, 

DO K2 = 1 TO r,. 

FN(K1)=FN(K1)+C(K2*1,K1)*X(L,K2),. 
END.. 
END,. 

THE LARGEST DISCRIMINANT FUNCTION 

LL =1,. 
FSUM =FN(1) ,. 

00 Kl = 2 TO K,. 
IF FSUM LT FN(K1 ) 
THEN DO.. 



/* 



LL 



=Kl, 



FSUM =FN(Kn, 
END,. 





DO KK = 1 TO K,. 




PL =PL*eXP(FN(Kt<)-FSUM),. 




END,. 




M =N1+1.. 




LG(Nl)=LLt. 




PtNl)=l/PL,. 




END,. 


END, 


• 


RETURN,. 




END,. 


/«ENO 



/«ENO OF PROCEDURE DSCR 



DSCR 
♦•/DSCR 

♦/DSCR 

♦/DSCR 

*/DSCR 

*/OSCR 

♦/OSCR 
DSCR 
DSCR 

OSCR 100 
DSCR 110 
OSCR 120 
DSCR 130 
OSCR 140 
OSCR 150 
S»/DSCR 160 
D*/DSCR 170 

«/DSCR 1 
OSCR 190 
DSCR 200 

*/DSCR 210 

•/DSCR 220 
OSCR 230 
DSCR 240 
DSCR 250 

•/DSCR 260 
DSCR 270 
DSCR 280 
OSCR 290 
DSCR 300 
OSCR 310 

♦/OSCR 320 

•/DSCR 330 
OSCR 340 
OSCR 350 
OSCR 360 
OSCR 370 
DSC 380 
DSCR 390 
DSCR 400 
DSCP 410 
DSCR 420 
OSCR 430 
OSCR 440 
OSCR 450 
DSCR 460 
DSCP 470 
DSCR 480 

*/DSCR 490 

♦ /OSC(^ 500 
•/OSCR 510 

DSCR 520 

OSCR 530 

DSCR 540 

DSCR 550 

OSCR 550 

OSCR 570 

DSCR 580 

DSCR 590 

DSCR 600 

DSCP 610 

OSCR 620 

*/OSCR 630 

*/OSCP 64C 

*/9SCR 650 

OSCR 660 

DSCR 670 

OSCR 680 

OSCR 590 

DSCR 700 

OSCR 710 

OSCR 72C 

DSCR 730 

OSCO 740 

OSCR 75C 

OSCR 76C 

DSCR 770 

DSCR 780 

DSCR 790 

DSC 800 

*/9SCR 810 

•/OSCR 920 

*/OSCP 830 

*/DSCR 840 

OSCR 850 

OSCR 860 

DSCR 870 

DSCR 88C 

OSCR 890 

OSCR 900 

DSCR 910 

DSCR 920 

OSCR 93C 

DSCR 940 

OSCR 950 

DSCR 960 

•/OSCR 970 

•/OSCR 930 

•/DSCR 990 

OSCRIOOO 

DSCRIOIC 

0SCR1020 

0SCR1030 

0SCR1040 

0SCR1050 

DSCR 1060 

D$CR107C 

OSCR 1080 

•/OSCR1090 

•/DSCRllOC 

• /DSCRIUO 
*/0SCRll20 

DSCR1130 
0SCR1140 
DSCR1150 
DSCR1160 
DSCR1170 
DSCP1180 
DSCR1190 
DSCR 1200 
0SCO1210 
0SCR1220 
DSCR1230 
•/DSCP 1240 
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Purpose: 

DSCR performs a discriminant analysis by calculat- 
ing a set of linear functions that serve as indices LG(NN) - 
for classifying an individual into one of K groups. 

Usage: 

CALL DSCR (K, M, N, X, XBAR, D, CMEAN, V, 

C, P, LG); Remarks: 



K - 

M- 
N(K)- 

X(NN, M) 



XBAR(M,K) 
D(M, JVI) - 
CMEAN(]Vn - 
V- 
C(MH,K) - 



P(NN) 



BINARY FIXED 

Given number of groups. K must 

be greater than 1. 

BINARY FIXED 

Given number of variables. 

BINARY FKED 

Given vector containing sample 

sizes of groups. 

N= (n^.ng nj^) 

BINARY FLOAT 
Given matrix containing data in 
the manner equivalent to a three- 
dimensional array [X^^i^}. The 
first subscript is case number; 
the second, variable number; the 
third, group number. NN=n2^ + 
n2 + ... + njj. 
BINARY FLOAT [(53)] 
Given matrix containing means of 
M variables in K groups. 
BINARY FLOAT [(53)] 
Given matrix containing the in- 
verse of pooled dispersion matrix. 
BINARY FLOAT [(53)] 
Resultant vector containing com- 
mon means. 
BINARY FLOAT [(53)] 
Resultant variable containing 
generalized Mahalanobis D-square. 
BINARY FLOAT [(53)] 
Resultant matrix containing the 
coefficients of discriminant func- 
tions. The first position of each 
column (function) contains the 
value of the constant for that 
function. 

BINARY FLOAT [(53)] 
Resultant vector containing the 
probability associated with the 
largest discriminant functions of 
all cases in all groups. Calcu- 
lated results are stored in the 
manner equivalent to a two-dimen- 
sional array (the first subscript 



is case number, and the second 
subscript is group number). 
NI^n,+n2+. . .+tok 
BINARY FIXED 
Resultant vector containing the 
subscripts of the largest dis- 
criminant functions stored in 
vector P. 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR=l - number of variables less than or equal 

to one. 
ERROR=2 - invalid number of groups (K s 1 or 

K> M). 
ERR0R=3 - no observations in one or more groups. 

The number of variables must be greater than or 
equal to the number of groups. 

Method: 

Refer to BMD Computer Programs Manual , edited 
by W.J. Dixon, UCLA, 1964, and T.W. Anderson, 
Introduction to Multivariate Statistical Analysis , 
John Wiley and Sons, 1958, 

Mathematical Background: 

This subroutine performs a discriminant analysis 
by calculating a set of linear functions that serve as 
indices for classifying an individual into one of K 
groups. 

For all groups combined, the following are ob- 
tained. 

Common means: 





K 








i: 


\ 


X., 


=^J 


fc=i 






K 








i: 


\ 






k=l 






where: 









(1) 



K = number of groups 

j = 1, 2 m are variables 
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XL = sample size in the k-th group 

X = mean of j-th variable in k-th group 

Generalized Mahalanobis Ir statistics, V: 



m 



K 



j=l k=l 



a. 



ijk 



i=l 



a.., = 



where: 



\ <^ik - ^i) <^Jk - ^3^ 



(2) 



d.. = the inverse element of the pooled dis- 
persion matrix D 



V can be used as chi-square (under assumption of 
normality) with m (K-1) degrees of freedom to test 
the hypothesis that the mean values are the same in 
all the K groups for these m variables. For each 
discriminant function k* = 1, 2 K, the fol- 
lowing statistics are calculated. 



where: 

k* = 1, 2, ..., K 

Probability associated with largest discriminant 
function: 



g g k* L 
k*= 1 

where: 

f = the value of the largest discriminant 
function 

L = the subscript of the largest discrimin- 
ant function 



(6) 



Coefficients: 




m 




s*=i; 


% V 


j=i 




where: 




i = 1, 2, 


..., m 


k = k* 




Constant: 






m m 


V=-l/2 


i: i: 




j=i 1=1 



d., X 



jl ""jk "hk 



(3) 



(4) 



For each i-th case in each k-th group, the following 
calculations are performed. 

Discriminant functions: 



j=l 



C X + C 
jk ijk Ok# 



(5) 
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Principal Components Analysis 
• Subroutine TRAC 



TRAC. 




TRAC 


10 


/««**** 


t»*************i^*********************»*************************/J(i.AC 


20 


/* 




•/TRAC 


30 


/* 


TO COMPUTE CUMULATIVE PERCENTAGE OF EIGENVALUES GREATER 


♦/TRAC 


*0 


/* 


THAN OR EQUAL TO A CONSTANT SPECIFIED BY THE USER. 


*/TRAC 


50 


/* 




•/TRAC 


60 


/*****«*«**««*«*««*««««»«**«[»*««4:««««*««:«««************««*«*«*********/TRAC 


70 


PROCEDURE (M,R,CON,K,PI». 


TRAC 


80 


DECLABE 


TRAC 


90 




ERROR EXTERNAL CHARACTER (11, 


TRAC 


100 




U,J,K,M) 


TRAC 


110 




FIXED BINARY, 


TRAC 


120 




(R(*,*I.O(*l ,CON) 


TRAC 


130 




BINARY FLOAT,. /*SINGLE PRECISION VERSION 


/*S*/TRAC 


140 


/* 


BINARY FLCAT (53),. /»DOUBLE PRECISION VERSION 


/•D*/TRAC 


150 


/* 




*/TRAC 


160 


ERROR='0',. 


TRAC 


170 


IF M 


LE /* ORDER OF MATRIX IS ZERO. 


•/TRAC 


180 


THEN 


00,. 


TRAC 


190 




ERROR='l',. 


TRAC 


200 




GO TO S2C,. 


TRAC 


210 




END,. 


TRAC 


220 




DO I = I TO M,. 


TRAC 


230 




END,. 


TRAC 


250 


K 


=c,. 


TRAC 


260 


/* 




•/TRAC 


270 


/* 


TEST WHETHER I-TH EIGENVALUE IS GREATER THAN OR EQUAL TO 


•/TRAC 


280 


/* 


THE CONSTANT. 


•/TRAC 


290 


/* 




•/TRAC 


300 




DO I = 1 TO M,. 


TRAC 


310 




IF D(I» LT CON 


TRAC 


320 




THEN GO TO SIC,. 


TRAC 


330 




K =K*1,. 


TRAC 


340 




0(1) =D(1)/M,, 


TRAC 


350 




END,. 


TRAC 


360 


SIO.. 




TRAC 


370 


IF K 


LE I 


TRAC 


380 


THEN 


00,. 


TRAC 


390 




ERR0R='2',. /♦ NOT ENOUGH EIGENVALUES 


•/TRAC 


400 




GO TO S2C,. /* ARE RETAINED 


•/TRAC 


410 




END,. 


TRAC 


420 




DO I = 2 TO K,. 


TRAC 


430 




D(I) =D(I1+D(I-1),. 


TRAC 


440 




END,. 


TRAC 


450 


S2C.. 




TRAC 


460 


RETURN,. 


TRAC 


470 


END. 


/*END OF PROCEDURE TRAC 


*/TRAC 


480 



Purpose: 

TRAC computes cumulative percentage of eigen- 
values greater than or equal to a constant specified 
by the user. 

Usage: 

CALL TRAC (M, R, CON, K, D); 

Description of parameters: 

M - BINARY FIXED 

Given number of variables. 

R(M, M) - BINARY FLOAT [(53)] 

Given matrix containing eigenvalues in 
diagonal. Eigenvalues are assumed to 
be arranged in descending order. 

CON- BINARY FLOAT [(53)] 

Given constant used to decide how many 
eigenvalues to retain. Cumulative per- 
centage of eigenvalues greater than or 
equal to this value is calculated. 

K - BINARY FIXED 

Resultant variable containing the number 
of eigenvalues greater than or equal to 
CON. (K is the number of factors. ) 

D(M) - BINARY FLOAT [(53)] 

Resultant vector containing cxmiulative 
percentage of eigenvalues greater than or 
equal to CON. 



Remark: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 



ERROR=l 
ERROI^2 



Method: 



order of matrix equal to zero, 
number of eigenvalues retained less 
than or equal to one. 



Each eigenvalue greater liian or equal to CON is 
divided by M, and the result is added to the pre- 
vious total to obtain the cumulative percentage for 
each eigenvalue. 

Mathematical Background: 

This procedure finds K, the number of eigenvalues 
greater than or equal to the value of a special con- 
stant. The given eigenvalues Xj, X2» •••. X jyj 
must be arranged in descending order. 

Cimaulative percentages for those K eigenvalues 
are: 



] 



] Z-/ M 



M 
i=l 

where: 

j = 1, 2, .... K 

M = number of eigenvalues (or variables) 

K s M 



(1) 



Statistics—Principal Components Analysis 213 



• Subroutine LOAD 



Method: 



LOAD.. 






LOAD 


10 


/•***** 


4««:4>«if««««*:«»««««* «««!*: *«««** 


*v*4:***i*»t:m********.****it**iHi**m***^*/l0A0 


20 


/* 






*/LOAD 


30 


/* 


TO COMPUTE A FACTOR MATRIX 


(LOAOINGI FROM EIGENVALUES AND 


♦/LOAD 


40 


/* 


ASSOCIATED EIGENVECTORS. 




♦/LOAD 


50 


/* 






*/LOA0 


60 


/«<■*»»♦*«!***»*****■***#**»<.* *<■»**»»* 


»*******»m**********:t**********i^***/lOt^D 


70 


PROCEDURE (M,K,R,V),. 




LOAD 


80 


DECLARE 




LOAD 


90 




(I< J.K) 




LOAD 


100 




FIXED BINARY, 




LOAD 


110 




EPROfi EXTERNAL CHAPACTEPdl 


, 


LOAD 


120 




(PI*,*) ,V(*,*),SQ> 




LOAD 


130 




BINARY FLOAT,. 


/♦SINGLE PRECISION VERSION 


/«S*/LOA0 


140 


/* 


8INAOY FLOAT (53»,. 


/♦DOUBLE PRECISION VERSION 


/*D»/LOA0 


150 


/* 






•/LOAD 


160 


ERROR='C',, 




LOAD 


170 


IF K 


LE 1 OP K GT M 


/* INVALID VALUE OF K 


♦/LOAD 


180 


THEN 


DO, . 




LOAD 


190 




fcfiRQR='2',. 




LOAD 


200 




GO TO FIN,, 




LOAD 


210 




END,. 




LOAD 


220 


IF M 


LE C 


/* ORDER OF MATRIX IS ZERO 


♦/LOAD 


230 


THEN 


Ecoo=l='l',. 




LOAD 


240 


ELSE 


DO,. 




LOAD 


250 




DO J = 1 TO K,. 




LOAD 


260 




SO =SOfiT(R(J,J)) ,. 




LOAD 


270 




DO I = 1 TO M,. 




LOAD 


280 




V( I ,J)=S0*V(1 ,J1 , 




LOAD 


290 




END,. 




LOAD 


300 




END, . 




LOAD 


310 




END,. 




LOAD 


320 


F[N.. 






LOAD 


330 


RETURN, . 




LOAD 


340 


END, 




/*END OF PROCEDURE LOAD 


*/LOAO 


350 



Purpose: 

LOAD computes a factor matrix (loading) from 
eigenvalues and associated eigenvectors. 

Usage: 

CALL LOAD (M, K, R, V); 

Description of parameters: 



M. 



K 



R(M, M) 



V(M, M) 



Remarics: 



BINARY FKED 

Given number of variables. 

BINARY FKED 

Given number of factors. 

BINARY FLOAT [(53)] 

Given matrix containing eigenvalues in 

the diagonal. Eigenvalues are assumed 

to be arranged in descending order. 

The first K eigenvalues are used by this 

procedure. 

BINARY FLOAT [(53)] 

Given matrix V contains eigenvectors 

columnwise. 

Resultant matrix V contains a factor 

matrix (M by K) . 



Normalized eigenvectors are converted to the factor 
pattern by multiplying the elements of each vector 
by the square root of the corresponding eigenvalue. 

Mathematical Background: 

This procedure calculates the coefficients of each 
factor by multiplying the elements of each normal- 
ized eigenvector by the square root of the corre- 
sponding eigenvalue. 

a.. = v.. ./x7 

where: 

i = 1, 2, ..., M are indices of variables 

j = 1, 2, ..., K are indices of eigenvalues 
retained (see the subroutine TRAC) 

K s M 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERR0R=1 - the order of the matrix is zero. 
ERROI^2 - invalid number of factors (K < 1 or 
K > M). 
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• Subroutine VRMX 



VRMX.. 




VRMX IC 1 


/»««««« 


ic««»*«««s««*4sw««*«**«««4««t««««n«***««« **«*'««««*«»****«««*•«««/ VRMX 2Q 1 


/* 






*/VRHX 30 


/* 




TO PERFORM ORTHOGONAL ROTATiCM OF A FACTOR MATRIX. 


*/VRMX 40 


/* 






*/VRMX 50 


/** ««««»«««:«**« «]K«i;< ««t«« «>!■*«««'« 4: ^^f^c^^^tt^fA*****!^** ****«>:'« 9« «:««««««« 


***/VP.'^X 6C 




PROCEDURE (M,K,fi.NC,TV.H,F,0) .. 


VRMX 70 




DECLARE 


VRMX 80 






(IiIItJ.KrKl.LLtMiNCtNV) 


VRMX 90 






FlxeO BINARY, 


VRMX ICO 






ERROR EXTERNAL CHARACTEH(l), 


VRMX 110 






(A(*,*»,TV(*) ,H(*),F1*) ,01*) ,FPS,TVLT,FN,AA,BB,CC,DO,G,B,U, 


r, VF.MX 12C 






COS4T,SIN4T,TAN^T,SINP,CnSP.CTN',T,COS2T,SIN2T, COST. SINT, CONS) VRMX 130 | 






BINARY FLOAT,. /*S1NGLE PRECISION VERSION / 


•■S*/VRMX 140 


/* 


BINARY fLTAT (53),. /*OOUBL£ PRECISION VERSION / 


»D*/VRMX 150 


/* 






*/VRMX 16C 




EPS 


=.0C116t. /* INITIALIZATION 


«/VRMX 170 




TVLT 


=0,. 


VRMX 180 




LL 


=K- 1 , . 


VRMX 190 




NV 


= l». 


VRMX 200 




NC 


=0,. 


VRMX 21C 




FN 


=M«M, . 


VRMX 22C 




CONS 


=.7071066,. 


VRMX 230 




ERROR** 0' ,. 


VRMX 240 




IF M 


LE 1 /* NUMBER Of VARIABLES LESS 


*/VRMX 250 




THEN 


DO,, /* THAN OR EQUAL TO ONE 


*/VRMX 260 






ERROR=' 1',. 


VRMX 270 






GO TO f IN,. 


VRMX 280 






END,. 


VRMX 290 




IF K 


LE 1 OR K GT M /* INVALID VALUE TF K 


*/VPMX 300 




THEN 


00,. 


VSMX 310 






ERR0R='2' ,. 


VRMX 320 






GO TO FIN,, 


VRMX 330 






END,. 


VRMX 340 


/« 






*/VRMX 350 


/* 




CALCULATE ORIGINAL COMMUNALITIES 


*/VPMX 360 


/* 






*/VRMX 370 






DO I = I TO M,. 


VRMX 380 






H(I) =0,. 


VPMX 39C 






DO J = I TO K.. 


VRMX 400 






HU) =H(I)+A(I ,J)*A(I,J) ,. 


VRMX 410 






END,. 


VRMX 42C 






END,. 


VRMX 430 


/* 






*/VRMX 440 


/* 




CALCULATE NORMALIZED FACTCP ^-ATRIX 


*/VRMX 450 


/* 






*/VftMX 460 






00 I = 1 TO M,. 


VRMX 470 






H( n =SQRT1H1I)) ,. 


VRMX 480 






DO J = 1 -^0 K,. 


VPMX 490 






A( I, J)=A(I, J)/H(I),. 


VRMX 500 






END,, 


VRMX 510 






END, . 


VRMX 520 




GO TO S20.. 


VRMX 53C 


/* 






*/VRMX 540 


f* 




CALCULATE VARIANCE FOR FACTOR MATRIX 


•/VRMX 550 


/* 






*/VRMX 560 


SIC. 




VRMX 570 




NV 


=NV+1,. 


VRMX 580 




TVLT 


=TV(NV-1),. 


VRMX 590 


S20.. 




VRMX 6C0 




TV(NV)=0,. 


VRMX 610 






00 J = 1 TO K,. 


VRMX 62C 






AA =C,. 


VRMX 630 






BE =0,. 


VRMX 640 






00 f = t TO M,, 


VRMX 65C 






cc =An,j)*A(i,j»,. 


V<?MX 660 






AA =AA+CC,. 


VRMX 670 






BB =BB+CC*CC,. 


VRMX 680 






END,. 


VRMX 690 






TV(NV) = TV(NV»*-(M*8e-AA*AA)/FN, . 


VRMX 700 






END,, 


VRMX 710 




IF NV GE 51 


VRMX 720 




THEN 


00,. /* NUMBER OF ITERATIONS = 50 


*/VRMX 730 






ERR0R='3',. 


VRMX 740 






GO TO sec,. 


VRMX 750 






END, . 


VRMX 760 




IF TV(NV)-TVLT LE l.CE-7 /« PERFORM CONVERGENCE TEST 


*/VRMX 770 




THEN 


00,. 


VRMX 780 






NC =NC + 1,. 


VRMX 790 






IF NC GT 3 


VRMX 800 






THEN GO TCI S80,. 


VPMX 810 






END,. 


VRMX 820 


/* 






VVRMX 83C 


/* 




ROTATIPN OF TWO FACTORS BEGINS 


*/VRMX 840 


/* 






*/VRMX 850 






DO J = 1 TO LL,. 


VRMX 860 






II =J+1,. 


VRMX 870 






00 Kl = II TO K,, 


VRMX 880 






AA =0,. /* CALCULATE NUM AND DEN 


*/VRHX 890 






BB =0,, 


VRMX 900 






CC =0,. 


VRMX 910 






DO =0,. 


VRMX 920 






00 I = 1 TO M,. 


VRMX 930 






U =(A(I,J|tA( I,K1))*(A(I,JI-A1 I,K1)),. 


VRMX 940 






T =A(I,J)*a(I,KlJ*2,. 


VRMX 950 






CC =CC*(U+T»*(U-T),. 


VRMX 960 






DD =DD*2*U*T,. 


VRMX 970 






AA =AA*-U,. 


VRMX 980 






BB =BB»T,. 


VRMX 990 






END,. 


VRMXIOOO 






T =DD-2*AA*BB/M,. 


VRMXIOIO 






e =CC-IAA*AA-B6*6B)/M,. 


VRMX1020 






IF T = a 


VPMX103'^ 






THEN DO,. 


VRMX1040 






IF T*B LT EPS 


VRNX1050 






THEN GO TO S7C,. 


VRMX1060 


/* 






♦/VRMX1070 


/* 




NUM * DEN IS GREATER THAN OF EQUAL TO THE TOLERANCE FACTOR 


♦/VRMX1080 


/* 






*/VRMXl090 






COS4r=C0NS,. 


VRMX I 100 






SIN4T=C0NS,. 


VRHXlltO 






GO TO S40,. 


VRHX1120 






END,. 


VRMX1130 






IF T GT B 


VRMX 1140 






THEN GO TO S30,. 


VRMX 1150 






TAN4T=AB$(T1/AB$<BI,. /* NUM IS LESS THAN OEN 


*/VRMX1160 






IF TAN4T GE EPS 


VRHX1170 






THEN DO,. 


VRMX1190 






C0S4T=l/SQRT(ltTAN4T*TAN4T>,, 


VRMX1190 






SIN4T=TAN4T»C0SAT,. 


VRMX1200 






GO TO S40,. 


VRHX1210 









END,. 


VRMX1220 






IF B 


GE 


VRMX1230 






THEN 


GO TO $70,. 


VRHX1240 






SINP 


=CONS,. 


VRMX 12 50 






COSP 


=CONS,. 


VRMX 1260 






GO TO S60,. 


VRMX 1270 


S30.. 








VRMX1280 






CTN4T=ABS(T/B»,. /* NUM IS GREATER THAN DEN 


•/VRHX1290 






IF CTN4T GE EPS 


VRMX1300 






THEN 


DO.. 

SIN4T=l/SQRT(l*CTN4T«CTN4Tlt. 

C0S4T=CTN4T*SIN4T,. 

GO TO S40,. 

END,. 


VRHXL310 
VRMXI320 
VRMX I 330 
VRMX 1340 
VRMX1350 






COS4T=0,. 


VRMX1360 






SIN4T=1.. 


VR7*X1370 


/* 








WRMX1380 


/* 


DETERMINE 


COS THEAT AND SIN THETA 


*/ VRMX 1390 


/* 








•/VRMX I 400 


S4C.. 








VRHX1410 






C0S2T=SQRT((l*C0S4T)/2),. 


VRKX1420 






SIN2T=SIN4T/t2*CDS2T),. 


VRMX 1430 






COST 


=SQRT((l*COS2T)/2l,. 


VRMX 1440 






SINT 


=S1N2T/(2*C0ST),. 


VRMX1450 


/* 








*/VRHX14«0 


/* 


DETERMINE 


COS PHI AND SIN PHI 


♦/VRMX1470 


/* 








•/VRMX1480 






IF 6 


GT 


VRMX1490 






THEN 


DO,. 

COSP =COST,. 
SINP =SINT,. 
GO TO S50,. 

END,. 


VRMX1500 
VRMX1510 
VRHX1520 
VRMX1530 
VRMX154C 






COSP 


=CONS*(COSTtSINTI,. 


VPMX1550 






SINP 


= flBS(CONS*(COST-SINTH,. 


VRMX 1560 


S50.. 








VRMX 1570 






IF T 


LE 


VRMXlSeO 






THEN 


SINP =-SINP,. 


VRMX1590 


S6C.. 






DO I = 1 TO H,. /* PERFORM ROTATION 

AA =A{I,J)»COSP+A(l,KU*SINP,. 

A(1,K1>=-AII,J)*SINP+A(1,K1»*C0SP,. 

A(I,J)=AA,. 

END,. 


VRMX1600 
•/VRHX1610 
VRMX1620 
VRMX1630 
VRMX1640 
VRMX1650 


S70,. 


END, 


END, 




VftMX1660 
VRMX1670 

VRMX 1680 


GO 


TO SIC 


,. 




VRMX1690 


/* 








♦/VRMX1700 


/* 


OENORMALIZE VARIMAX LOADINGS 


*/VRHX1710 


/« 








*/VRMX1720 


S80,. 








VRMX1730 




DO I 


= 1 


TO M,. 


VRMX 1740 






DO J 


= 1 TO K,. 


VRMX1750 






A(l, 


Jt = An,J)*H<It ,. 


VRMX 1760 






END, 




VRMX1770 




END, 






VRHX1780 


NC 


=NV- 


i,. 


/* CHECK ON COMMUNALITIES 


«/VRHX1790 


H 


=H«H 


, . 




VRMX1800 




00 I 


"^ 1 


TO M,. 


VRMX1810 




Fd) 


=0,. 




VRMX1820 






DO J 


= 1 TO K,. 


VRMX1830 






Fill 


=F(I)+AU,J)*A(I,J),. 


VRMX 1840 






END, 




VRHXieSO 




DID 


=H(I)-F(n,. 


VRMX 1860 




END, 






VRMX 1870 


FIN.. 








VRMX1880 


RETURN, . 






VRMX1890 


END 






/*END OF PROCEDURE VRMX 


♦/VRMX1900 



Purpose: 

VRMX performs an orthogonal rotation of a factor 

matrix. 

Usage: 

CALL VRMX (M, K, A, NC, TV, H, F, D); 

M - BINARY FIXED 

Given number of variables. 

K - BINARY FIXED 

Given number of factors. 

A(M,K) - BINARY FLOAT [(53)] 
Given factor matrix. 
Resultant rotated M x K factor matrix. 

NC - BINARY FIXED 

Resultant variable containing the num- 
ber of iteration cycles performed. 

TV(51) - BINARY FLOAT [(53)] 

Resultant vector containing the var- 
iance of the factor matrix for each 
iteration cycle. The variance prior to 
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the first iteration cycle is also calcu- 
lated. This means that NO+1 varian- 
ces are stored in vector TV, Maximum 
number of iteration cycles allowed in 
this procedure is 50. 

H(M) - BINARY FLOAT [(53)] 

Resultant vector containing the origi- 
nal communalities. 

F(M) - BINARY FLOAT [(53)] 

Resultant vector containing the final 
communalities. 

D(M) - BINARY FLOAT [(53)] 

Resultant vector containing the differ- 
ence between the original and final 
communalities. 



where i = 1, 2, 



m 



Normalized factor matrix: 



b.. = a.. 
1] 11 




where: 



i= 1,2, . . . , m 

j = l,2,. . . ,k 

Variance for factor matrix: 



(3) 



Remains: 

If the variance computed after each iteration cycle 
does not increase for four successive times, the 
procedure stops rotation. 

If no errors are detected in the processing of 
data, the error indicator, ERROR, is set to zero. 
The following constitute the possible error condi- 
tions that may be detected: 

ERROR=l - number of variables less than or equal 
to one. 

ERROR=2 - invalid number of factors (K^l or K >M). 

ERR0R=3 - 50 iterations executed without conver- 
gence. 

Method: 

Kaiser's varimax rotation as described in "Compu- 
ter Program for Varimax Rotation in Factor Analy- 
sis" by the same author, Educational and Psycholo- 
gical Measurement, vol. XDC, no. 3, 1959. 

Mathematical Background: 

This subroutine performs orthogonal rotations on 
an m by k factor matrix such that 



m 



^A 



:?M] 



(1) 



E 

J 

is a maximum, where i = 1, 2, . . . , m are var- 
iables, j = 1, 2, .... k are factors, ajs is the 
loading for the i-th variable on the j-th factor, and 
h? is the communality of the i-th variable defined 
below. 

Commimalities: 



k 

.f=E 



2 

a.. 

1] 



(2) 






m 



E 



m-^ 1J 



/,m 



(4) 



where c = 1,2, . . . (iteration cycle) 
Convergence test: 

If V - V , s 10 "'^ 
c c-1 



(5) 



four successive times, the program stops rotation 
and performs equation (28). Otherwise, the pro- 
gram repeats rotation of factors until the conver- 
gence test is satisfied. 

Rotation of two factors: 

The subroutine rotates two normalized factors 
(by) at a time — 1 with 2, 1 with 3, . . . , 1 with k, 
2 with 3, . . . , 2 with k, .... k - 1 with k. This 
constitutes one iteration cycle. 

Assuming that x and y are factors to be rotated, 
where x is the lower-numbered or left-hand factor, 
the following notation for rotating these two factors 
is used: 



x„ y„ 
2 ^2. 



X y 
m •'m 



cos <)) -sin 4 
sin (j) cos (j> 



X, 



X„ 



X Y 
m m 



(6) 
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where xj and yj are presently available normalized 
loadings, and Xj and Yj, the desired normalized 
loadings, are functions of ()>, the angle of rotation. 
The computational steps are 1 through 5 below: 

1. Calculation of NUM and DEN: 



= Z^ (x,+ 



y.) (x. - y.) 
1 •'i' M •'i' 



B 



= 2 ^ x.y. 
i 



D 

NUM 
DEN 



[(Xj-Hyj)(Xj-y.)-2x^y.] 

= 4 2-> (X. + y.) (x^ - y^) x. y. (7) 

= D - 2AB/m 

= C - [(A+ B) (A- B) ] /m 



2. Comparison of NUM and DEN: 

The following four cases may arise. 

NUM < DEN, go to (2a) below 

NUM > DEN, go to (2b) below 

(NUM+ DEN) s €*, go to (2e) below 

(NUM+ DEN) < e, skip to the next rotation 

* e is a small tolerance factor. 

a. tan 46 = I NUM|/| DEN| (8) 

If tan 46 < e and 

DEN is positive, skip to the next rotation. 

DEN is negative, set cos <^ = 
sin 4> = ( V2" )/2 and go to step 5. 



If tan 46 s f , calculate: 



cos 46 « l/Vl + tan 49 



VI + 



sin 46 = tan 46 • cos 46 

and go to step 3. 

b. ctn 46 = I NUM|/| DEN| 

If ctn 46 < e , set cos 46 = and 
sin 46 " 1. Go to step 3. 

If ctn 46 s e , calculate: 



(10) 



(11) 



sin 46 = l/Vl + ctn^46 


(12) 


cos 46 » ctn 46 • sin 46 


(13) 


and go to step 3. 





c. Set cos 46 = sin 46 = (•/2I/2 and go 
to step 3. 



3. Determining cos 6 and sin 6: 



cos 26 = -7(1 + cos 46)/2 

sin 26 = sin 46/2 cos 26 

cos 6 = /^(l + cos 26)/2 

sin 6 = sin 26/ 2 cos 6 

4. Determining cos ^ and sin 1^. 

a. If DEN is positive, set 

cos ^ = cos 6 

sin <|) = sin 6 
and go to (4b). 

If DEN is negative, calculate 
cos <|) = -— - cos 9 + -T- sin 6 



sin <b = 



N^ 



cos 6 



(9) 



2 2 

and go to (4b). 
b. K NUM is positive, set 
cos 4) = cos <t> 
sin if = sin (() 
and go to step 5. 



sin 6 



(14) 
(15) 
(16) 
(17) 



(18) 
(19) 



(20) 
(21) 



(22) 
(23) 
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If NUM is negative, set 
cos 4> = cos ({> 
sin <)> = - sin ([> 



5. Rotation: 



X. = X, cos S+ y. sin 4 



Y. = X. sin 4> + y. cos A 
1 1 -^i ^ 



(24) 
(25) 

(26) 
(27) 



Nonparametrlc Statistics 



Subroutine KLMO 



where 



i= 1, 2, ..., m 



After one cycle of k(k - l)/2 rotations is completed, 
the subroutine goes back to calculate the variance 
for the factor matrix by equation (4). 



Denormaliz ation: 

a,. = b,. . h 
i] i] i 

where: 

i = 1, 2, ..., m 
J ~ 1, 2, ,.,,k 
Check on communalities: 

Final communalities 

k 

.2 Y^ 2 

f. = / a.. 

j = l 



(28) 



(29) 



Difference 



d^ =h. 



f2 
1 



(30) 



where i * 1, 2, . . . , m. 



KtMO.. 




KLMO 10 


/**««*« 


tL******************.********»:»**it*******m*****************:**** 


"/KLMO 20 


/* 




*/KLMO 30 


/* 


TESTS THE DIFFERENCE BETWEEN EMPIRICAL AND THEORETICAL 


*/KLMO 40 


/• 


DISTRIBUTIONS USING THE KOLMOGOROV-SMIRNOV TEST. 


•/KLMO 50 


/* 




»/KLMO 60 


/**««*«*»«*»**««>k*«««***«***«**4********«*************«««*«******««**»/KLH0 70 1 


PROCEDURe(X,N,Z»PROB,IfCOD,U.S»,. 


KLMO 60 


DECLARE 


KLMO 90 




(X1*),Y,TEMP,PR0B,S.U,Z,0,0N,EI,ES,FI,FS) FLOAT BINARY, 


KLMO 100 




(ItJ*IL,N.lFCODI FIXED BINARY* 


KLMO I 10 




ERROR EXTERNAL CHARACTER (U.. 


KLMO 120 


ERROR=«0',. 


KLMO 130 


IF N 


LT ICO 


KLMO 140 


THEN 


IF N=0 /* N < 100--SET ERROR INO. 


*/KLHO 150 




THEN DO,. 


KLMO 160 




EPR0R='4*,. 


KLMO 170 




GO TO see. 


KLMO 180 




END,. 


KLMO 190 




ELSE ERR0R-'3',. 


KLMO 200 




DO 1=1 TO N-1,. /* SORT X INTO 


*/KLMO 21C 




00 J=Ii-l TO N,. /* ASCENDING SEQUENCE 


♦/KLMO 220 




IF xin GT XIJ) 


KLMO 230 




THEN DO,. 


KLMO 240 




TEMP =x(n,. 


KLHO 250 




XII) =XtJ),. 


KLMO 260 




X(J) =.TEMP,. 


KLMO 270 




END,. 


KLMO 280 




END,. 


KLHO 290 




END,. 


KLMO 300 




/* COMPUTES MAX. OEV. ON IN 


*/KLMa 310 




/* ABS. VAL. BETWEEN EMP. AND 


*/KLMa 320 




/* THEO. FUNCTIONS OVER ALL X 


*/KLMO 330 


ON,FS=0.0,. 


KLMO 340 


IL 


= 1,. 


KLMO 350 


SIO.. 




KLMO 360 




DO I-IL TO N-W. 


KLHO 370 




J -I.. 


KLMO 3fl0 




IF X(J}-XtJ«^l) 


KLMO 390 




THEN GO TO S20,. 


KLMO 400 




ELSE GO TO S40,. 


KLMO 410 


S20.. 




KLMO 420 


END. 




KLMO 43C 


S30,. 




KLMO *,40 


J 


■ N,. 


KLMO 450 


540.. 




KLMO 460 


IL 


-=J»l.. 


KLMO 470 


Fl 


=F$,. 


KLMO 480 


FS 


»FLOAT(J)/N,. /* EMP. OIST. FUNCT. CALCULATED*/KLMO A90 1 


IF IFC0D=2 


KLMO 500 


THEN 


DO,. 


KLMO 510 




IF S LE 


KLMO 520 




THEN 


KLMO 530 


S50.. 




KLMO 540 




00,. /* INVALID VALUE OF S 


♦/KLMO 550 




ERROR-M',. 


KLMO 560 




60 TO seoi. 


KLMO 570 




END.. 


KLMO 580 




ELSE 00,. /* EXPONENTIAL PDF 


*/KLMQ 590 




I =tXIJ)-U)/S+l.C.. 


KLMO 600 




IF Z LE 


KLMO 610 




THEN /* Z < OR = 


*/KLMO 620 


S60.. 




KLMO 630 




DO,. 


KLMO 640 




Y =0.0,. 


KLMO 650 


S70.. 




KLMO 660 




EI =ABS(Y-FI),. 


KLMO 670 




ES =ABS(Y-FS),. 


KLMO 660 




/* COMPUTE MAX. OEV. ON BETHEEN«/KLMO 690 | 




/• EMP. AND THEO. FUNCTIONS 


♦/KLMO 700 




DN =MAX(DN,EI,ES),. 


KLMO 710 




IF IL=N 


KLMO T20 




THEN GO TO S3C,. 


KLMO 730 




ELSE IF IL LT N 


KLMO 740 




THEN GO TO SIO,. 


KLMO 750 




ELSE DO,. 


KLMO 760 




/* CALC. ASYMPTOTIC VALUES 


•/KLMO 770 




/* USING SMIR 


*/KLMO 780 




Z =ON*SQRT(N),. 


KLMO 790 




CALL SMIR (Z,PROB),. 


KLMO 800 




PROB"1.CEC-PROB,. 


KLMO aio 




GO TO sec,. 


KLMO 820 




ENO,. 


KLMO 830 




END,. 


KLMO 840 




ELSE DO,. /* EXPONENTIAL PDF 


*/KLMO 850 




Y=1.-EXPC-Z>,. 


KLMO 860 




GO TO S70,. 


KLMO 870 




END,. 


KLMO 880 




END.. 


KLMO 890 




END,. 


KLMO 900 


ELSE 


IF IFCOD LT 2 


KLMO 910 




THEN IF S LE 


KLMO 920 




THEN GO TO S50,. /* INVALID VALUE OF S 


*/KLMO 930 




ELSE DO,. /* NORMAL POF 


♦/KLMO 940 




Z =(X( J)-U1/S,. 


KLMO 950 




CALL NOTRIZ.Y.O),. 


KLMO 960 




GO TO S70,. 


KLMO 970 




END.. 


KLMO 980 




ELSE IF IFC0D=4 


KLMO 990 




THEN IF S LE U 


KLMOIOOO 




THEN GO TO S50,. /* INVALID VAL. OF S OR U 


♦/KLMOIOIO 




ELSE IF XU) LE U /« UNIFORM POF 


♦/KLM01020 




THEN GO TO S6C,. 


KLMO 1030 




ELSE IF XIJl LE S 


KLH01040 




THEN 00.. 


KLM01050 




Y =(X(J)-UI/($-UI.. 


KLMO 1060 




GO TO S70». 


KLN01070 




END.. 


KLMO 1080 




ELSE 00,. 


KLMO 1090 




Y -1,0,. 


KLMOllOO 




GO TO S70,. 


KLMOlllC 




END,. 


KLM01120 




ELSE IF IFCOO LT 4 


KLM01130 




THEN IF S>0 /* INVALID VALUE OF S 


♦/KLM01140 




THEN GO TO S50,. 


KLM01150 




ELSE 00,. /* CAUCHY POF 


♦/KLMO 1160 




Y -ATAN(U(J)-U)/SI*0,3163099*0.5.. 


KLMO 1170 




GO TO S70,. 


KLM01180 




END,. 


KL NO 1190 
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ELSE E>1R0R""2" 



-.80.. 

RETURNt 
END*. 



/* USER'S PDF 



/*END OF PROCEDURE KLHO 



•/HLH01200 
KLH01210 
KLHOIZZO 

*/KI.M01230 



Purpose: 

KLMO tests the difference between empirical and 
theoretical distributions using the Kolmogorov- 
Smlmov test. 

Usage: 

CALL KLMO (X, N, Z, PROB, IFCOD, U, S); 

X(N) - BINARY FLOAT 

Given vector of independent observations. 

N - BINARY FIXED 

Given number of observations in X. 

Z - BINARY FLOAT 

Resultant variable containing the greatest 
value with respect to X of n/n ( | F (x) - 
F(x) I ), where F(x) is a theoretical dis- 
tribution function and Fj^(x) is an 
empirical distribution function. 

PROB - BINARY FLOAT 

Resultant variable containing the prob- 
ability of the statistic being greater than 
or equal to Z if the hypothesis that X is 
from the density under consideration is 
true. For example, PRO&=0. 05 implies 
that X can be considered to be from the 
density under consideration with 5% 
probability of being incorrect. 
PROB=l. - SMIR (Z). 

IFCOD - BINARY FIXED 

Given code denoting the particular 
theoretical probability distribution 
function being considered. When IFCOD 
=l,F(x) is the normal PDF 
=2,F(x) is the exponential PDF 
=3,F(x) is the Cauchy PDF 
=4,F(x) is the uniform PDF 
=5,F(x) is user- supplied. 

U - BINARY FLOAT 

When IFCOD is 1 or 2, U is the given 

mean of the density given above. 

When IFCOD is 3, U is the given median 

of the Cauchy density. 

When IFCOD is 4, U is the given left 

endpoint of the uniform density. 

When IFCOD is 5, U is user- specified. 

S - BINARY FLOAT 

When IFCOD is 1 or 2, S is the given 
standard deviation of density given above, 
and should be positive. 
When IFCOD is 3, (U-S) specifies the 



first quartile of the Cauchy density. 
S given should be nonzero. 
If IFCOD is 4, S is the given rigjit end- 
point of the uniform density. S should 
be greater than U. 
If IFCOD is 5, S is user-specified. 



Remarks: 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR?=l - invalid value of S (if IFCOD = 4, 

S or U is invalid). 
ERR0R=2 - requested user' s PDF has not been 

supplied. 
ERROR=3 - number of observations less than 100. 
ERROR=4 - number of observations equal to zero. 

N should be greater than or equal to 100 (see the 
mathematical background for subroutine SMIR, for 
the asymptotic formulae). Also, probabilily levels 
determined by this program will not be correct if 
the same samples used in Ms test are used to 
estimate parameters for the continuous distribution. 

Any user- supplied cumulative probability dis- 
tribution function should be coded beginning with 
program comments "USER'S PDF" and should 
return to S70. 

Subroutines and function subroutines required: 

SMIR 
NDTR 

Method: 

For references see: 

W. Feller, "On the Kolmogorov-Smirnov limit 
theorems for empirical distributions". Annals of 
Math. Stat. , 19, pp. 177-189. 

N. Smimov, "Table for estimating the goodness of 
fit of empirical distributions" , Annals of Math. 
Stat. . 19, pp. 279-281. 

R. Von Mises, Mathematical Theory of Probability 
and Statistics. Academic Press, New York, 1964, 
pp. 490-493. 

B.V. Gnedenko, The Theory of Probability. 
Chelsea Publishing Co. , New York, 1962, pp. 384- 
401. 
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H. W. LiUiefors, "On the Kolmogorov-Smimov test 
for normality with mean and variance unknown" , 
J. A. S. A. . 62 (1967), pp. 399-402. 

Mathematical Background: 

Given a sample of n Independent and identically dis- 
tributed random variables Xj, X2 Xjj with 

continuous cumulative distribution function F(x), 
this subroutine tests the difference in absolute value 
between the empirical distribution Fu(x) and theo- 
retical distribution F(x), using Kolmogorov- 
Smimov' s limiting distribution. 

For this purpose: 

1. The order statistics { x(i) } are determined 
from the set {xj}by sorting {xi} into a nondecreas- 
ing sequence. 

2. The empirical cumulative distribution function 
Fn(x) is computed. This is the following step-func- 
tion: 



F^(x) =( 





k/n 

1 



X < X 



(1) 



^(k)^^<Vi)''^^'-'°"^ 



X, . S X 

(n) 



3. The maximum deviation D^ in absolute value 
between the empirical and theoretical distribution 
is computed: 



D = Max 
n 

-<»<x<<» 



|F^(x)- F(x)| 



Since F^{x) and F(x) are nondecreasing functions, 
the result is: 



D = Max 
Isk^n 



"n bm] -^ [\)] 



Dq is a random variable, and L(z) is the limiting 
cumulative distribution function of n^/^ D^: 

Urn Prob |n D < z} = L(z) 

n-> ay 



4. Finally, the values are computed for: 
1/2 



z = n 



D 



and the probability of being greater than or equal to 
the computed value of n^/^ j)^ jg computed: 



P = 1 - L(z) 

Generally, theoretical distribution functions are 
to be included by the user, as specified in the pro- 
gram. However, four functions are evaluated in 
KLMO, as follows: 



x 

/ 



dF(t) = F(x) 



(1) 



is evaluated at the points of the set {x . } , where 
F(x) is one of the following: ^*^ 

• The normal pdf with mean u and variance s2 

• The exponential pdf with mean u and variance 



• The Cauchy pdf with median u, and first 
quartile s - u 

• The uniform pdf with endpoints u and s 

Any user-written pdf should evaluate equation (1) 
above, using the parameters u and s at his con- 
venience. Instructions given in the program KLMO 
should be followed. 

LiUiefors (1967) notes that critical values de- 
termined by this test are not correct when one or 
more parameters are estimated from the sample. 
The user should refer to his article for notes on 
approximations that may be considered if such 
estimates are used. 

Programming Considerations: 

It is doubtful that the user will wish to perform this 
test using double-precision ax3curaxjy. However, if 
one wishes to communicate with KLMO in a double- 
precision program, he might declare 

XX FLOAT BINARY (53) 

X FLOAT BINARY 
Before calling KLMO, the user might do the 
following: 

DO I = 1 TO N, . 

X(I) =XX(I), . 

END,. 
After exiting from KLMO, the user might do the 
the following: 

DO I = 1 TO N, . 

XX(I) » X(I), . 

END,. 

(Note that subroutine SMIR has the double-precision 
option. ) 
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Subroutine KLM2 





KLM2.. 


KLH2 10 


/****««*«**«*****««*****««*««**»****««'«*>*>»*****«**********««**********/KLM2 20 1 


/* 


*/KLM2 30 


/* TESTS THE DIFFERENCE BETMEEN TWO SAMPLE DISTRIBUTION 


*/KLM2 40 


/« FUNCTIONS USING THE KOLMOGORCV-SMIRNOV TEST. 


•/KLM2 50 


/* 


*/KLM2 60 


/»*******«*«***«**«****************«***«*«**»****»«»**********«»**»***/KLI12 70 1 


PROCEDURE (X,Y.N,M,Z,PROB),. 


KLH2 80 


DECLARE 


KLM2 90 


(X(*».Yt*).TEMP»XMl,XNI,Z,PROB,DI FLOAT BINARY* 


KLM2 100 


(I.J.K,L.M,N> FIXED BINARY. 


KLM2 110 


EPEGP EXTERNAL CHARACTER (I).. 


KLM2 120 


ERROR-'C. 


KLM2 130 


IF N LT ICO OP M LT ICO /* M OR N IS LESS THAN 100 


*/KLH2 140 


THEN IF N=0 OR M-0 /» SET ERROR INDICATOR 


♦/KLM2 150 


THEN 00,. 


KLM2 160 


ERPQC=t<^«,, 


KLH2 170 


GO TO 360,. 


KLH2 180 


END,. 


KLM2 190 


ELSE ERR0R-'3',. 


KLM2 200 


DO 1=1 TO N-1,. /* SORT XINTO 


*/KlM2 210 


DO J=I+1 TO N,. /* ASCENDING SEQUENCE 


*/KLH2 220 


IF X(I) GT XtJ) 


KLM2 230 


THEN DO,. 


KLM2 240 


TEMP =xn),. 


KLM2 250 


x<n =xij)f. 


KLM2 260 


X(J) =TEMP,. 


KLH2 270 


END.. 


KLM2 280 


END,. 


KLM2 290 


END,. 


KLR2 300 


DO 1=1 TO H-I,. /* SORT Y INTO 


*/KLH2 310 


00 J=I+1 TO M,. /* ASCENDING SEQUENCE 


*/KLH2 320 


IF Ydl GT YU) 


KLM2 330 


THEN 00,. 


KLN2 340 


TEMP =-Y(n,. 


KLM2 350 


Yt I 1 =VIJ>,. 


KLM2 360 


Y(JI =TEMP,. 


KLM2 3TC 


END,. 


KLH2 380 


END,. 


KLM2 390 


END,. 


KLH2 400 


XNl =l/FL0AT(N),. /• CALC. 0-ABS(FN-6Ml 


»/KLM2 410 


XMl =l/FLOATIMl.. /* OVER THE SPECTRUM OF X £ Y 


*/KLM2 420 


D.I.J,K,L =0,. 


KLM2 430 


SIO.. 


KLH2 440 


IF YIJ+IJ GT XIMl) 


KLM2 450 


THEN DC, . 


KLM2 460 


K=l,. 


KLM2 470 


S2n.. 


KLM2 480 


1=^1+1,. 


KLM2 490 


IF N LE I 


KLM2 500 


THEN DO,. 


KLM2 510 


L=l,. 


KLM2 520 


GO TO S30,. 


KLM2 530 


END,. 


KLM2 540 


ELSE IF XII) GE X(l+ll 


KLM2 550 


THEN GO TO 520,. 


KLM2 560 


ELSE 


KLM2 57C 


S3C.. 


KLM2 580 


IF K - 


KLM2 590 


THEN 


KLM2 600 


S40.. 


KLM2 610 


00,. 


KLM2 620 


J=J+1,. 


KLM2 630 


IF J LT M 


KLM2 640 


THEN IF Y(J*1) LE Y(J> 


KLM2 650 


THEN GO TC S40,. 


KLM2 660 


ELSE GC TO S50,. 


KLM2 670 


ELSE DO,. 


KLM2 680 


L=l,. 


KLM2 690 


GO TO S5C,. 


KLMZ 700 


END,. 


•CLM2 71C 


END,. 


KLM2 720 


ELSE GO TO S50,. 


KLM2 730 


END,. 


KLM2 74C 


ELSE IF X(I+1) = YU*1> 


KLM2 750 


THEN 00,. 


KLM2 760 


K=C,. 


KLM2 770 


60 TO S20,. 


KLM2 780 


END,. 


XLM2 790 


ELSE GO TO S40,. 


KLM2 800 


/* CHOOSE THE MAXIMUM 


•/KLM2 810 


/* DIFFERENCE, D 


*/KLM2 820 


S50.. 


KLM2 830 


D =MAX(D,ABSIFLOAT(n*XNl-FLOAT(J)*XMl)),. 


((LM2 840 


IF L=0 


KLM2 850 


THEN GO TO SIO,. 


t(LM2 860 


ELSE 00.. 


KLM2 870 


/* CALCULATE THE STATISTIC Z 


*/KLM2 880 


/* AND Z'S PROBABILITY 


•/KLM2 890 


Z =D*SQRT((FLDAT(N)*FLOATlMl)/tFLOAT(N)+FLOATIMm,. 


KLM2 900 


CALL SMIR (Z.PROB),. 


KLM2 910 


END,. 


KLM2 930 


S60.. 


KLM2 940 


RETURN,. 


KLM2 950 


END,. /* END OF PROCEDURE KLM2 


*/KLM2 960 



Purpose: 

KLM2 tests the difference between two sample dis- 
tribution functions using the Kolmogorov-Smirnov test. 

Usage: 

CALL KLM2 (X, Y, N, M, Z, PROB); 

X(N) - BINARY FLOAT 

Given vector containing N independent 
observations. 



Y(M) 

N- 
M- 
Z - 



BINARY FLOAT 

Given vector containii^ M independent 

observations. 

BINARY FIXED 

Given number of observations in X. 

BINARY FIXED 

Given number of observations in Y. 

BINARY FLOAT 

Resultant variable containing the greatest 

value with respect to the spectrum of X 

and Y of 



MN 
M+N 



(|^N<^>-^M<y)|) 



PROB 



where Fj^ is the empirical distribution 
function of the set (x) and Gj^iy) is the 
empirical distribution function of the set 

(y). 

BINARY FLOAT 

Resultant variable containing the prob- 
ability of the statistic being greater than 
or equal to Z if the hypothesis that X and 
Y are from the same PDF is true. For 
example, PROB=0. 05 implies that one 
can reject the null hypothesis that the 
sets X and Y are from the same density 
with 5% probability of being incorrect. 
PR0B=1-SMIR (Z). 



Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERR0R=3 - number of observations N, or number 
of obseirvations M, less than 100. 

ERROR=4 - number of observations N, or number 
of observations M, equal to zero. 

See the mathematical background for this sub- 
routine and for subroutine SMIR, concerning 
asymptotic formulae. 

Subroutines and function subroutines required: 
SMIR 

Method: 

For references see: 

W. Feller, "On the Kolmogorov-Smirnov limit 
theorems for empirical distributions". Annals of 
Math. Stat., 19, pp. 177-189. 
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N. Smirnov, "Table for estimating the goodness of 
fit of empirical distributions", Annals of Math. 
Stat. . 19, pp. 279-281, 

B.V. Gnedenko, The Theory of Probability. 
Chelsea Publishing Co. New York, 1962, pp. 384- 
401. 

Mathematical Background: 

Given a sample of n i. i. d. (independent and indenti- 
cally distributed) random variables X, and a sample 
of m i. i. d. random variables Y, this subroutine 
tests Hie difference between the two empirical dis- 
tribution functions Fn(x) and G^Cy) using 
Kolmogorov-Smirnov's limiting distribution. For 
this purpose: 

1. The sets X and Y are sorted into the ordered 
sets {X^js} and Cy^jv], which are nondecreasing se- 
quences. 

2. The empirical cumulative distribution func- 
tions Fn(x) for the set X, and Gjn(y) for the set Y, 
are computed. For example, 



r 







X <x 



(1) 



^(x)=/k/n x^x<x ;k=l n-1 



^(n) 



(k+1)' 



Programming Considerations: 

It is doubtful that the user will wish to perform this 
test usii^ double-precision accuracy. Howfcvt i if 
one wishes to communicate with KLM2 in a double- 
precision program, he might declare 

(XX, YY) FLOAT BINARY (53) 
(Y,X) FLOAT BINARY 

giving X and XX, Y and YY the same dimensions. 

Before calling KLM2, he might do the foUovmg: 



DO 1=1 TO N, . 
X(l) =XX(I),. 
END,. 



DO J=l TO M, , 

Y(J)=YY(J),. 

END,. 



Immediately after exiting from KLM2, he might do 
the following: 

DO 1=1 TO N, . DO J=l TO M, . 

XX(I)=X(]),. YY(J)=Y(J),. 

END,. END,. 



3. The maximum difference in absolute value 
betvi/een the two sample distribution functions is 
coxt-DUted: 



:ai,n 



max 
X, y 



F (x) - G (y) 
n ' m"' 



/ mn 
The statistic ^/j^+jj "Dy^ jj is a random variable with 

limiting cumulative diptribution function L(z), which 

is described under subroutine iMIR in this manual. 

That is. 



lim 
m,n-*<^, " 



Prob. 



ra+c 



'-} 



L(z) 



4. Fin ally, t he probability (asympf^'te) of the 
stati.-jcic a/^P- I^m,n being not less ttia its com- 
puted value, under the assumption of equality of the 
two theoretical distribution functions from which X 
and Y were taken, is computed: 

P = 1 - L(z) 
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• Subroutine SMIR 



Method: 



SHIR.. 




SMIR IC 


/*********«*********9*******************:t,***********:*»i*»:***'»i$i***0*1HLt*/SI*lK 20 i 


/* 




*/SMlR 30 


/* 


COMPUTES VALUES OF THE LIMITING DISTRIBUTION FUNCTION FOR 


THE*/SMIR 4C 


/* 


KOLMOGOROV-SMIRNOV STATISTIC. 


»/SWIR 50 


/• 




*/SMIP 60 




******««*♦*«**»«**#*#«,*,**»*♦:„.,*,*«„**„,#»*«„*, *„,*,„^,„.C- IP 70 I 


PROCEDURE (X,Y),. 


SMIR 60 


DECLARE 


SMIR 90 




lX,Y,Ql,02,Q<i,Q8) FLOAT BINARY, ./*SINGLE PRECISION 


/*S»/SHIR 100 


/* 


(X.Y, 01,02,04,08) FLOAT BINARY ( 53 ) , ./*D0U8LE PRECISION 


/*0*/SMIR lie 


IF X 


LT 1.0 


SMIR 120 


THEN 


IF X LE .2T /* X LESS THAN .27-SET Y 


*/SMIR 130 




THEN Y =0.C,. 


SMIR 14C 




/* CALCULATE L(Kl 


*/SHIP 150 




/* IN RANGE (.27,1) 


*/SM!R 160 




ELSE DO,. 


SMIR 170 




Ql =EXP|-1.233701E0/X**2),. /♦ SINGLE PREC. 


/*S*/SM1R 180 


/* 


01 =E XP{- 1.233 700501 36 170E0/X**2>,. 


SMIR 190 




/» DOUBLE PREC. 


/*D*/SMIR 200 




02 =01*01*. 


SfIR 210 




04 =02*02,. 


SMIR 220 




08 =04*04,, 


SMIR 230 




IF Q8-1.0E-25 GE 


SMIR 240 




THEN Y =(2.506628EO/X)*01*(1.0EO*08*(1.GEO+Oe*08)),. SMIR 250 | 




/* SINGLE PREC. 


/*S*/SMIR 260 


/♦ 


THEN Y =I2.506628274631001EO/XI*Ql*(1.0EOfrQe* 


SMIR 270 




tl.0EC*0a*08)),. /* DOUBLE PREC. 


/*D*/SMIR 280 




ELSE Y =(2.5C6628EC/'X)#01,. /* SINGLE PREC. 


/*S*/SMIR 290 


/• 


ELSE Y =(2.506628274631001EO/X)*01,. 


SMIR 300 




/* DOUBLE PREC. 


/*D*/SHIR 310 




END,. 


SMIR 320 


ELSE 


IF X LT 3.1 


SMIR 330 




/* CALCULATE L(X) 


*/SMIfi 340 




THEN DO,. /» IN RANGE (1,3. 11 


*/SMIR 350 




01 =EXP(-2.0EC*X*X»,. 


SMIR 360 




02 =01*01,. 


SMIP 370 




04 =02*02,. 


SMIR 380 




08 =04*04,. 


SMIR 390 




Y =1.0EC-2.0E0* I 01-04+08* (01-08)),. 


SMIR 400 




END.. 


SMIR 410 




ELSE Y =1.0*. /* X > OR - 3.1~SET Y 


•/SMIR 420 


RETURN,. 


SMIP 430 


END* 


/* END OF PROCEDURE SMIR 


•/SMIR 440 



Purpose: 

SMIR computes values of the limiting distribution 
function for the Kolmogorov-Smimov statistic. 

Usage: 

CALL SMIR (X, Y); 

X - BINARY FLOAT [(53)] 

Given variable containii^ the argument of the 

Smirnov function. 
Y - BINARY FLOAT [(53)] 

Resultant variable containing the Smirnov 

function value. 

Remarks: 

Accuracy tests were made referring to the table 
given in the reference below. 

Two arguments, X=. 62, andX=l. 87, gave re- 
sults that differ from the Smirnov tables by 2.9 and 
1. 9 in the 5**^ decimal place. All other results 
showed smaller errors, and error specifications 
are given in the accuracy tables in this manual. In 
double-precision mode, these same arguments re- 
sulted in differences from tabled values by 3 and 2 

t"h 

in the 5"^ decimal place. It is noted in Lindgren 
(reference below) that for high-significance levels 
(say, . 01 and . 05) asymptotic formulas give values 
that are too high (by 1. 5% when N=80). That is, at 
high-sifenificance levels, the hypothesis of no differ- 
ence will be rejected too seldom using asymptotic 
formulas. 



For references see: 

E, T. Whittaker and G. N. Watson, A Course of 
Modern Analysis, Cambridge University Press, 
Cambricfee, England, 1952, 462-476. 

W. Feller, "On the Kolmogorov-Smimov limit 
theorems for empiral distributions", Annals of 
Math. Stat. 19, pp. 177-189. 

N. Smirnov, "Table for estimating the goodness. of 
fit of empirical distributions", Annals of Math. Stat. 
19, pp. 279-281. 

V. W. Lindgren, Statistical Theory, The Macmillan 
Company, New York, 1962. 

Mathematical Background: 

This subroutine computes the values of Kolmogorov- 
Smirnov's limiting distribution for a given argu- 
ment X. 



L(x) 



10 



1-2 



Eh)"-' 



xso 



2 2 
exp(-2k X ) x>0 



(1) 



k=l 



L(x) is the limit (Kolmogorov) of the cumulative 
distribution function of VeTDji, and of (Smirnov) 
[mn/(m+n)]-^/^ Dj^j ^ where: 

Dji is the maximum, over all x, of the differ- 
ence I Fn(x) - F(x) I between the sample distribu- 
tion function Fn(x) and the continuous theoretical 
distribution function F(x), and 

I^m.n is the maximum, over all x, of the differ- 
ence between ttie two sample distribution functions 
Fin(x) and Gn(x), from two independent samples of 
sizes m and n. 
When X is very small, the series (1) converges 
slowly, but, using Jacobi's theta-functions 
e2(u,t) and e4(u,t): 



e2(u,t) =2^ exp [iff(k+l/2)^t]cos[(2k+l)u] 
k=0 

GO 

e^(u,t) = 1-2 ^ (-1)^"''' exp(itrk^t) cos (2ku) 
k=0 
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and using the Jacob! imaginary transformation 

-1/2 

9^(0, t) = (-it) 62(0, -i/t) 



it follows that: 



• Subroutine CHSQ 



L(x) = e (0, 2ixVir) 



= (Vli/x) 2^ exp [-(2k-l)^ TT^ /8x^] 
k=l 

which converges quickly when x is small. The com- 
putation here uses, with errors Ej(x), i=l,2: 



r 



X £ 0. 27 



(V27/X) V exp [-(2k-l)V/8x^]- 



k=l 



L(x)=< 



1-2 



E (x); 0.27 <x< 1.0 



^ (-1) "^exp(-2kV) +E2(x) 
k=l 



1.0 sx<3.1 
3. 1 sx< " 



where: 



-15. 



E (x) ^ 6 (10 ) when x < 1 

-20 
Eg (x) < 10 when x a 1 



CHSO.. 




CHSQ 10 


/******************«***#*******«*******«******************************/CHSQ 20 1 


/♦ 




»/CHSQ 30 


/• 


TO COHPUTE CHI-SOUARE FROH A CONTINGENCY TABLE. 


•/CHSQ 40 


/• 




♦/CHSQ 50 


/*«******«»*****«****************««*«**«***«****««**«*«******«********/CHSQ 60 1 


CROCEOURE (A,N,M,CS,NOF,P,TP),. 


CHSQ 70 


DECLARE 


CHSO 80 




ERROR EXTERNAL CHARACTER 111, 


CHSQ 90 




(A(»,»1,CS,SS,TRIN>,TC(HI.P,TP,E) 


CHSQ 100 




BINARY FLOAT) /*$1NGLE PRECISION VERSION 


/*S*/CHSQ 110 


/• 


BINARY FL0ATI53I, /«DOUBLE PRECISION VERSION 


/•0-/CHSQ 120 




(I.lCOUNT.J,n,N,N0F,NA,NB,NC,NO,NAB,NCD,NAC.NBD,NZ) 


CHSO 130 




FIXEO BINARY, 


CHSO 140 




IUN,F,N,Wl,U2,IO,H4) FLOAT BINARY(S3I>. 


CHSQ 190 


/• 




•/CHSO 160 


ERROft»*0*t. 


CHSQ 170 


CS 


-CO.. 


CHSQ IBO 


P 


=0.0,. 


CHSQ 190 


rp 


-0.0,. 


CHSQ 200 


NDF 


-(N-1)*(H-I),. /« FIND DEGREES OF FREEOOH 


•/CHSQ 210 


IF N 


LE 1 OR N LE I 


CHSQ 220 


THEN 


00,. 


CHSQ 230 




ERROR.'Z',. /• DEGREES OF FREEOOH - 


•/CHSQ 240 




GO TO FIN,. 


CHSQ 250 




END,. 


CHSQ 260 


/* 




•/CHSQ 270 




DO I = 1 TO N,. /* CALCULATE ROW TOTALS 


•/CHSQ 280 




TRCn=0.0,. 


CHSQ 290 




DO J - 1 TO M,. 


CHSO 300 




TRIII>TRIII«AII,JI,. 


CHSQ 310 




END,. 


CHSQ 320 




IF TR(I) LE 


CHSO 330 




THEN DO,. /• SOHE ROH TOTAL • ZERO 


•/CHSQ 340 




ERR0R='3',. 


CHSO 350 




GO TO FIN,. 


CHSQ 360 




ENO,. 


CHSQ 370 




END,. 


CHSQ 380 




DO J = 1 TO M,. /• CALCULATE COLUMN TOTALS 


•/CHSQ 390 




TC(J)-0.0,. 


CHSQ 400 




00 I > 1 TO N,. 


CHSO 410 




IC<J)=TC(JltA(l,JI,. 


CHSQ 420 




END,. 


CHSQ 430 




IF TCCJI LE 


CHSQ 440 




THEN 00,. 


CHSQ 450 




ERROR-* 3*,. /* SOHE COLUMN TOTAL - ZERO 


•/CHSQ 460 




GO TO FIN,. 


CHSQ 470 




END,. 


CHSQ 480 




END,, 


CHSO 490 


CS 


-0.0,. /* COMPUTE GRAND SUM 


•/CHSQ 500 




DO I = 1 TO N,. 


CHSQ 510 




GS -GS«TR(I),. 


CHSQ 520 




END,. 


CHSQ 530 


/• 




•/CHSQ 540 


/• 


COHPUTE CHI-SQUARE FOR 2 BY 2 TABLE (SPECIAL CASEl 


•/CHSO 550 


/* 




•/CHSQ 560 


IF N 


= 2 AND H = 2 


CHSQ 570 


THEN 


00,. 


CHSQ 580 




CS -GS*IABSIAI1,1)«AI2.2I-AI2,1)«AI1 21) 


CHSQ 590 




-GS/2.0)»«2/ITC(l)»TCI2l«TRIll»TRI2ll,. 


CHSQ 600 




IF GS GT 40.0 


CHSQ 610 




THEN GO TO FIN,. 


CHSQ 620 




ELSE DO,. 


CHSQ 630 




IF (TRI1)»TCI1I)/GS GE 5.0 AND 


CHSQ 640 




ITRI2I«TC(1)1/GS GE 5.0 ANO 


CHSO 650 




ITRI1)*TCI2))/GS GE 5.0 ANO 


CHSO 660 




(TRI2)»TCI2I1/CS GE 5.0 


CHSQ 670 




THEN GO TO FIN,. 


CHSQ 680 




ELSE 00,. 


CHSQ 690 




NA -All,l),. 


CHSQ 700 




NB -AU,2),. 


CHSO 710 




NC -A(2,l),. 


CHSQ 720 




NO >A(2,2},. 


CHSO 730 




K -1,. 


CHSQ 740 


/* 




•/CHSQ 750 


/• 


OBTAIN THE HARGINAL TOTALS AND GRAND TOTAL 


•/CHSO 760 


/• 




•/CHSQ 770 




NAB -NA+NB,. 


CHSQ 780 




NCD -NC+NO,. 


CHSQ 790 




NAC -NA«NC,. 


CHSQ 800 




NBO -NB-^NO,. 


CHSQ 810 




NZ -NAtNB«NC-fNO,. 


CHSO 820 


/» 




•/CHSQ 830 


/♦ 


COHPUTE N FACTORIAL 


•/CHSQ 840 


/• 




• /CHSQ 850 




HN -1,. 


CHSQ 860 




IF NZ GT 1 


CHSO 870 




THEN 00,. 


CHSQ 880 




DO I - 2 TO NZ,. 


CHSO 890 




FI -I,. 


CHSQ 900 




HN =WN*FI,. 


CHSQ 910 




END,. 


CHSQ 920 




END,. 


CHSQ 930 


/» 




•/CHSQ 940 


/• 


COMPUTE EXACT PROBABILITY 


•/CHSQ 950 


/• 




•/CHSQ 960 


SIO.. 




CHSQ 970 




Wl -I,. 


CHSQ 980 




IF NB GT 


CHSQ 990 




THEN DO,. 


CHSQIOOO 




J -NA«1,. 


CHSQIOIO 




00 I - J TO NAB,. 


CHSQ1020 




FI -I,. 


CHSQ1030 




Ml -H1*FI,. 


CHSQ1040 




END,. 


CHSQ1050 




END,. 


CHSQ1060 




H2 =1.0,. 


CHSQ1070 


^ IF NC GT 


CHSQ1080 




THEN DO,. 


CHSQ1090 




J -N0>1,. 


CHSOllOO 




DO 1 - J TO NCD,. 


CHSQlllO 




FI =1,. 


CHSQ1120 




H2 =W2*F1,. 


CHSQ1130 




END,. 


CHSQ1140 




END,. 


CHS0I150 




H3 '1.0,. 


CHS01160 




IF NA GT 


CHSQ1170 




THEN 00,. 


CHSQllBO 




J =NC»I,. 


CHSQ1I90 




00 I - J TO NAC*. 


CHSQ1200 




FI =1,. 


CHSQ1210 




H3 -H3*F1,. 


CHSal220 




ENO,. 


CHSQI230 
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END.. 










CHSQ1240 






H4 -1.0.. 










CHSQL250 






IF NO GT 










CHSQt260 






THEN 00,. 










CHSgi270 






J *NB*1,. 










CHS012B0 






DO I . J TO NBD,. 










CHSQ1290 






FI -1,. 










CHSQ1300 






H4 -H4*FI*. 










CHSai310 






END,. 










CHS01320 






END.. 










CHS01330 






HI -H1*W2*W3*H4.. 










CHSQ1340 






H >H1/HN,. 










CHS01350 






p •P«H.. 










CHSQI360 






IF K GT 1 










CHSQ1370 






THEN TP -TP*y,. 










CHSQ1380 






K -K»l,. 










CHSQ13W 


/• 














*/CHSQ1400 


/• 




TEST WHETHER FREQUENCY IS ZERO (0) 










•/CHsgi4io 


/♦ 














•/CHSQI«0 






IF NA LE OR NB LE OR NC LE 


OR 


NO 


LE 





CHSgiA30 






THEN GO TO FIN,. 










CHSQ1440 


/* 














•/CHSQ1450 


/• 




ADJUST DATA IN ORDER TO COMPUTE THE PROBABILITY 


ASSOCIATED 


*/CHSQL4«0 


/* 




KITH HORE EXTREME FREQUENCIES (BUT NITH 


SAME 


MARGINAL TOTALSI*/CHSQ1470 | 


/* 




IF NA LE N8 
THEN DO,. 

IF NC LE NO 
THEN DO.. 

IF NA GT NC 
THEN GO TO S20,. 
END,. 
GO TO S25.. 
END,. 
If NC GT NO 
THEN 00,. 

IF NB GT NO 
THEN GO TO S25,. 
END,. 










»/CHSQ14eO 
CHSQ1490 
CHSQISOO 

cHsgisio 
CHsgiuo 

CHSgi530 
CHSgi940 

CHsgisso 

CHSgiMO 
CHSgiSTO 
CHSQlSeO 
CHSai590 
CHSQ1600 
CHSQ1610 
CHSQI620 


/* 














•/CHSQI630 


/• 




MOVE B TO A AND C TO 










*/CHSQL640 


/• 














•/CHSgi650 


S20 




NA sNA^l.. 
NB -NB-I,. 
NC -NC-l,. 
NO -NO*!,. 
GO TO SIC. 










CHSQ1660 
CHSQI670 
CHSQI6eo 
CHSQ1690 
CHSQ1700 
CHSQ17I0 


/* 














♦/CHSQ1720 


/♦ 




HOVE A TO B AND TO C 










VCHSQ1730 


/♦ 














•/CHSQI740 


S25 




NA >NA-I.. 
N8 =NB+I,. 
NC -NC»1,. 
NO >ND-I,. 
GO TO SIO,. 
END,. 
END,. 










CHSQI750 
CHSQI760 
CHS01770 
CHSQ1780 
CHSgi790 
CHSgiBOO 

CHsgieio 

CHSQ1820 






END,. /• END OF 


TWO 


BY 


TWO 


CASE 


♦/CHSQ1830 


/• 














•/CHSQie40 


/• 




COMPUTE CHI SQUARE FOR OTHER CONTINGENCY TABLES 






♦/CHsgieso 


/• 




ICOUNT=0. . 

DO J = 1 TO H,. 

00 I - 1 TO N,. 

E .TRII1»TC(J)/GS,. 

IF E LE 5.0 

THEN ICOUNT-ICOUNTtl,. 

CS =CS+(A(I.J)-E)*(A(I.J>-E)/E.. 

END,. 
END,. 










•/CHSQ1860 
CHSgi870 
CHSQ1880 
CHSQie90 
CHSQ1900 
CHSQ19I0 
CHSQI920 
CHSQ1930 
CHSQ1940 
CHSQI950 




IF ICOUNT GT 










CHSQ1960 




THEN 


ERR0R=*1',. /* SOME EXPECTED 


YALUES ARE 


♦/CHSQ1970 


/» 




/* LESS THAN 5 


.0 






*/CHSQ19eo 


FIN 


., 












CHSQ1990 




RETURN*. 










CHSQ2000 




END, 


/» END OF 


PROCEDURE 


CHSQ 


«/CHSg20L0 



Purpose: 

CHSQ computes chi-square from a contingency 
table. 

Us£^e: 

CALL CHSQ (A, N, M, CS, NDF, P, TP); 

A(N,M) - BINARY FLOAT [(53)] 

Given matrix containing contingency 

table of integer values. 
N - BINARY FIXED 

Given number of rows in matrix A. 
M - BINARY FIXED 

Given number of columns in matrix A. 
CS - BINARY FLOAT [(53)] 

Resultant chi-square. 
NDF - BINARY FIXED 

Resultant number of degrees of freedom. 



TP- 



BINARY FLOAT [(53)] 
Resultant exact probability for a 2x2 
contingency table. If the contingency 
table is not 2x2, the value of P will be 
zero (P=0). 

BINARY FLOAT [(53)] 
Resultant variable containing the prob- 
ability by the Tocher-modification 
method for a 2x2 contingency table. IE 
the contingency table is not 2x2, the 
value of TP will be set to zero (TP=0). 



Remarks: 



P, CS, and TP above are computed only when the 
contii^ency table is 2x2, the total of the frequencies 
is less than or equal to 40, and the expected fre- 
quency in any cell is less than five. 

If no errors are detected in the processing of 
data, the error indicator, ERROR, is set to zero. 
The following constitute ihe possible error condi- 
tions that may be detected: 

ERROR=l - some expected values less than 5. 0. 
ERR0R=2 - degrees of freedom equal to zero. 
ERROR=3 - some row total or column total less than 
or equal to zero. 

Method: 

Described in S. Siegel Nonparametric Statistics for 
the Behavioral Sciences , McGraw-Hill, New York, 
1956, chapters 6 and 8. 

Mathematical Background: 

When the observations are classified by two char- 
acteristics (two-way classification), the chi-square 
test may be used to test the hypothesis that IJie two 
characteristics are independent — namely, that the 
distribution of one characteristic is the same re- 
gardless of the other characteristic. Two-way- 
classification tables of this type are frequently 
called contingency tables, and different formulas 
are used to compute chi-square for the foUowii^ 
two types of contingency tables: 

1. For 2x2 table: 



N( 



a. X 



AD-BC 



_N 2 
2' 



(A + B) (C + D) (A + C) (B + D) 



(1) 



where A, B, C, and D stand for frequencies in a 
2x2 table as shown below, and N = A + B + C + D. 
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Yes 



No 



Male 



Female 



A 


B 


C 


D 



b. If N ^ 40 and the expected frequency in 
any cell is 5, the Fisher exact proba- 
bility is computed. 

The exact probability of observii^ a 
particular set of frequencies in a 2 x 2 
table, when the marginal totals are re- 
garded as fixed, is given by the form- 
ula: 

(A+B)' (C+D)I (A+O: (B+D)' 



Ni a: b: c: d: 



(2) 



8! 6! 6! 8! 
^c 14! 0! 8! 6! 0! 



1/3003 = . 00033 



The probability associated with the oc- 
currence of values as extreme or more ex- 
treme than those observed (table a) is giv- 
en by adding the three probabilities 

. 13986 + . 01598 + . 00033 = . 15617 

Thus, pp = . 15617 is the Fisher exact 
probability. 

Tocher's modification determines the 
probability of all cases more extreme than 
the observed one, and not including the ob- 
served one. 



However, more extreme distribu- 
tions of frequencies could occur with 
the same marginal totals. 

To find the Fisher exact probability, 
we add the probability of obtaining the 
existing distribution of frequencies to 
the probabilities of obtaining all the 
more extreme distributions of frequen- 
cies. 

The more extreme distributions of 
frequencies are determined by system- 
atically subtracting one from the small- 
est frequency in the table, while keep- 
ing the marginal totals fixed. This 
iterative process continues until the 
smallest cell has a zero value. This is 
the most extreme case. 



PF = Pa-'Pb-'Pc-r-- 



For example: 

Observed data More extreme outcomes with same 

marginal totals 
table a table b table c 



2 


6 


8 
6 


1 


7 


8 
6 





8 


4 


2 


5 


1 


6 






Pt = Pb ^ Pc ^ • • • 



That is, 



Pt = Pf - Pa 



(3) 



(4) 



For the example in tables a, b, and c: 

p^ = . 01598 + . 00033 = , 01631 using 
equation (3) 



p^ = . 15617 - . 13986 = . 01631 using 
equation (4) 

The probability (prp) provided by 
Tocher's modification to the Fisher ex- 
act test is for a one-tailed test of Hq. 
For a two-tailed test, the p,j, yielded 
must be doubled. 



2. For other contingency tables: 

2 



n m (A.. - E..) 



(5) 



i=l j=l E.. 



where: 



8 14 



8 14 



8 14 



A.. = frequency in the cell i, j 



_ 8! 6! 6! 8! 
^a 14! 2! 6! 4! 2! 



= 20/143 = . 13986 



T. T. 

ij N 



(6) 



Pb 



8! 6! 6! 8! 
14! 1! 7! 5! 1! 



= 16/1001 = . 01598 



^i= .^, 



j=l 



A.. 
1] 



i = l, 2, . 



, n (row totals) 
(7) 
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T. = X) A., j = 1, 2,. . . , m (column totals) 

(8) 



• Subroutine KRNK 



^ i~l '^ 



N = ^ T. (grand total) 
1=1 ^ 

The degrees of freedom: 

d. f. - (n - 1) (m - 1) 



(9) 



(10) 



KRNK.. 




KRNK 10 


/*****«4 


«*«**«*«****«*«***«***«*««**********«*««**********************/KRNK 20 1 


/* 




*/KRNK 30 


/* 


TO TEST CORRELATION BETWEEN TWO VARIABLES BY H6ANS OF THE 


*/KRNK 40 


/* 


KENDALL RANK CORRELATION COEFFICIENT. 


♦/KRNK 50 


/* 




♦/KRNK 60 


/t****t**i:**9<t*v» ***************************************************** /KRm. 70 1 


PROCEDURE (A,B,Rl,R2,N,TAU,S0.Z,NP),. 


KRNK 60 


DECLAFE 


KRNK 90 




(A(*l,B(*).Rl(*).R2(*).TAU,SD,Z,RSAVe,SAVER,S,TA,rB,FNl.FN) 


KRNK 100 




FLOAT BINARY, 


KRNK no 




(I,ISQRT,J,KTtN,NR) 


KRNK 120 




BINARY FIXED, 


KRNK 130 




ERROR EXTERNAL CHARACTER III,. 


KRNK 140 


/* 




*/KRNK 150 


ERROR^'O',. /* INITIALIZATION 


♦/KRNK 160 




00 1=1 TO N,. 


KRNK 170 




Run =0,. 


KRNK 180 




ft2(II =0,. 


KRNK 190 




END.. 


KRNK 200 


TAU 


=0.0,. 


KRNK 210 


SO 


=0.0,. 


KRNK 220 


Z 


=0.0,. 


KRNK 230 


IF N 


LE 1 /• NUMBER OF OBSERVATIONS LESS 


♦/KRNK 240 


THEN 


DO,. f* THAN OR EQUAL TO ONE. 


*/KRNK 2 50 




ERRnR='l',. 


KRNK 260 




GO TO FIN,. 


KRNK 270 




END,. 


KRNK 280 


FN 


=N,. 


KRNK 290 


FNl 


=N*(N-1),. 


KRNK 300 


If NR= 1 /• DETERMINE IF DATA IS RANKED 


♦/KRNK 310 


THEN 


DO,. 


KRNK 320 




00 1 = I TO N,. 


KRNK 330 




RUn = fi(n,. /■* MOVE RANKED DATA TO Rl R2 


*/KRNK 340 




R2(n = 6(I),. 


KRNK 350 




END,. 


KRNK 360 




END,. 


KRNK 370 


ELSE 


00.. 


KRNK 360 


/* 




•/KRNK 390 


/* 


RANK DATA IN A AND 8 VECTORS AND ASSIGN TIED OBSERVATIONS 


*/KRNK 400 


/« 


AVERAGE OF TIED RANKS. 


♦/KRNK 410 


/» 




♦/KRNK 420 




CALL RANK <A,RI,N),. 


KRNK 430 




CALL RANK (B,R2,NI,. 


KRNK 440 




END,. 


KRNK 450 


SIO., 




KRNK 460 


lSOfiT=0,. 


KRNK 470 


/* 




♦/KRNK 480 


/* 


SORT RANK VECTORS Rl AND R2 IN SEQUENCE OF VARIABLE A 


•/KRNK 490 


/* 




•/KRNK 500 




DO I = 2 TO N,. 


KRNK 510 




IF RIUJ LT Rin-lt 


KRNK 520 




THEN 00,. 


KRNK 530 




IS0RT=IS0RTtl,. 


KRNK 540 




RSAVE=Rl(n,. 


KRNK 550 




Rl(n = RUI-ll.. 


KRNK 560 




Rl( I-1)=RSAVE,. 


KRNK 570 




SAVER=R2(n,. 


KRNK 580 




R2(I)=R21I-11,. 


KRNK 590 




R2(I-1)=SAVER,. 


KRNK 600 




END,. 


KRNK 610 




END,. 


KRNK 620 


IF I SORT NE 


KRNK 630 


THEN 


GO TO SIC. 


KRNK 640 


/* 




•/KRNK 650 


/* 


COMPUTE S ON VARIABLE B. STARTING WITH THE FIRST RANK, ADO 1 


♦/KRNK 660 


/* 


TO S FOP EACH LARGER PANK TO ITS RIGHT AND SUBTRACT 1 FOR 


♦/KRNK 670 


/* 


EACH SMALLER RANK. REPEAT FOR ALL RANKS. 


•/KRNK 680 


/* 




•/KRNK 690 


S 


=0.. 


KRNK 700 




00 I = 1 TO N-l,. 


KRNK 710 




DO J = I+l TO N,. 


KRNK 720 




IF R2(J) GT R2(n 


KRNK 730 




THEN S =S+l.O,. 


KRNK 740 




ELSE IF R2(J) LT R2(I) 


KRNK 750 




THEN S =S-1.0.. 


KRNK 760 




END, . 


KRNK 770 




END,. 


KRNK 780 


/* 




•/KRNK 790 


/* 


COMPUTE TIED SCORE INDEX FOF BOTH VARIABLES 


•/KRNK 600 


/* 




♦/KRNK 810 


KT 


= 2,. 


KRNK 820 


CALL 


TIE tFl,N,KT,TA),. 


KRNK 830 


IF (;rR0R='2' 


KRNK 840 


THEN 




KRNK 850 


S20.. 




KRNK 660 




00,. /* ALL RANKS FOR ONE VARIABLE 


•/KRNK 870 




EFCGP='3',. /« APE EQUAL 


*/KPNK 880 




GO TO FIN,. 


KRNK 890 




END.. 


KRNK 900 


CALL 


TIE (R2,N,KT,TB),. 


KRNK 910 


IF EPR0!: = '2* 


KRNK 920 


THEN 


GO TO S2C.. 


KRNK 930 


IF Tfi= 0.0 AND TB = 0.0 /* COMPUTE TAU 


•/KRNK 940 


THEN 


TAU =S/(0.5*FN1I,. 


KRNK 950 


ELSE 


TAU =S/( (SORTtC.5*FNl-TA))*(SQRT(0.5*FNl-l «))>,. 


KRNK 960 


/* 




♦/KRNK 970 


/* 


COMPUTE STANDARD DEVIATION AND Z VALUE IF N IS 10 OR GREATER 


•/KRNK 980 


/* 




•/KRNK 990 


IF N 


GE 10 


KRNKIOOO 


THEN 


00,. 


KRNKIOIO 




SD =( SQpTn2.0*(FN+FN+^))/t9.0*FNlll),. 


KRNK1020 




Z =TAU/SD.. 


KRNK 1030 




ENO , . 


KRNK 1040 


ELSE 


ERR0R='2',. /* SAMPLE SIZE LESS THAN 10 


•/KRNK105C 


FIN.. 




KRNK1060 


RETURN,. 


KRNK1070 


END. 


/*ENO OF PROCEDURE KRNK 


•/KRNK1080 



Purpose: 

KRNK measures the correlation between two varia- 
bles by means of the Kendall rank correlation co- 
efficient. 
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Usage: 



Mathematical Background: 



CALL KENK (A, B, Bl, E2, N. TAU, SD, Z, NR); 



A(N)- 

B(N)- 

R1(N) - 

R2(ig) - 

N- 
TAU- 

SD - 



NR - 



BINARY FLOAT 

Given vector containii^ observations 
for the first variable. 
BINARY FLOAT 

Given vector containing observations 
for the second variable. 
BINARY FLOAT 

Resultant vector containing rank of the 
data in vector A. 
BINARY FLOAT 

Resultant vector containing rank of 
the data in vector B. 
BINARY FIXED 
Given number of observations. 
BINARY FLOAT 

Resultant variable containii^ the Ken- 
dall rank correlation coefficient. 
BINARY FLOAT 

Resultant variable containing standard 
deviation. 
BINARY FLOAT 

Resultant variable containing statistic 
to be used to measure the significance 
of TAU in terms of normal distribution. 
BINARY FIXED 
Given code containing the following: 

- for raw data in vectors A and B. 

1 - for the rank of data in vectors A 

and B. 



Remarks: 



If no errors are detected in the processing of data, 

the error Indicator, ERROR, is set to zero. The 

foUowii^ constitute the possible error conditions 

that may be detected: 

ERROR=l - number of observations less than or 
equal to one. 

ERROR=2 - sample size less then 10. If this con- 
dition exists, Rl and R2 wUl contain 
invalid values; SD and Z will be set to 
zero. 

ERR0R=3 - all ranks for one variable are equal. 

Subroutines and function subroutines required: 
RANK 
TIE 

Method: 

Described in S. Siegel, Nonparameteric Statistics 
for the Behavioral Sciences . McGraw-Hill, New 
York, 1956, chapter 9. 



The subroutine computes the Kendall rank correla- 
tion coefficient, given two vectors of n observations 
for two variables, A and B. The observations on 
each variable are ranked from 1 to n. Tied obser- 
vations are ass^ed the average of the tied ranks. 
Ranks are sorted in sequence of variable A. 
A correction factor for ties is obtained: 



T^ - 2_, — 2 for variable A 



b ^ 



t(t - 1) 



(1) 



for variable B 



where t = number of observations tied for a given 
rank. 

The Kendall rank correlation coefficient is then 
computed for the following two cases: 



(1) if T and T are zero, 

3. D 



n (n - 1) 



(2) 



where: 



n = number of ranks 

S = total score calculated for ranks in vari- 
able B by selecting each rank in turn, ad- 
dii^ 1 for each larger rank to its right, 
subtracting 1 for each smaller rank to its 
right. 

(2) if T and/or T, are not zero, 
a b 



i 



(3) 



|n(n-l)-T^^|n(n-l)-T^ 



The standard deviation is calculated: 



s = 



2(2n + 5) 
9 n (n - 1) 



(4) 



The statistic used to measure the significance of t 
is: 
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• Subroutine QTST 













OIST,. 








QTST 10 


/**4i*«*4 


i,»***t**«***«***»****************»************************** 


»*/QTST 20 


/* 








•/QTST 30 


/* 


TO TEST WHETHER THREE OR MORE 


MATCHED GROUPS OF DICHOTOMOUS 


*/OTST 40 


/* 


DATA DIFFER SIGNIFICANTLY 


PY THE COCHRAN Q-TEST. 


*/QTST 50 


/* 








*/QTST 60 


/♦*****«***««*»*»•♦**•***•*♦*****«*****«****«**♦****•*»********•***♦ 


»*/QTST 70 


PROCEDURE UtNtHtO.NDF),. 






QTST flO 


DECLARE 






QTST 90 




ERROR EXTERNAL CHARACTER 


I). 




OTST 100 




U(*,*>,TRlN),TC(Mt ,0,RSQ 


,cso 


,GD,FM» 


QTST 110 




BINARY FLOAT, 






QTST 120 




(I,JtM,N,NDF) 






QTST 130 




BINARY FIXED, . 






QTST 140 


/* 








•/QTST 150 


ERROR='0' t. 






QTST 160 


IF M 


LT 3 OR N LE 1 




/* NUMBER OF CASES IN EACH 


♦/QTST 170 


THEN 


DO, . 




/• GROUP IS LESS THAN 3 OR 


♦/QTST 180 




errors' 1« ,. 




/• THE NUMBER OF OBSERVATIONS 


♦/QTST 190 




GO TO FIN,. 




/* IS LESS THAN OR EQUAL TO 


♦/QTST 200 




END,. 




/• ONE. 


♦/QTST 210 


FH 


sM, . 






QTST 220 


/♦ 








♦/QTST 230 


/* 


COMPUTE SUM OF SQUARES OF 


ROM 


AND COLUMN TOTALS RSQ AND CSQ, 


♦/OTST 240 


/* 


AND GRAND TOTAL OF ALL ELEMENTS. 


*/QTST 250 


/* 


DO I " 1 TO N,. 
TRI11=0.0,. 

DO J = 1 TO H,. 

TR(n = TRin+A(I »J) ,. 

END,. 
END,. 






•/OTST 260 
QTST 270 
QTST 280 
QTST 290 
OTST 300 
QTST 310 
QTST 320 




00 J = 1 TO M,, 




/* CALCULATE COLUMN SUMS 


♦/QTST 330 




TC(J1*0.0,. 






QTST 340 




DO I = I TO N,. 






QTST 350 




TC(J)=TC(J)*AII,J1,. 






QTST 360 




END,. 






QTST 370 




END,. 






QTST 380 


Q 


■0.0,. 






OTST 390 


NOF 


=0.0,. 






QTST 400 


GD 


'=0.0,. 






QTST 410 


RSO 


=0.0,. 






QTST 420 


CSQ 


=0.0,. 

00 1 = I TO N,. 






QTST 430 
QTST 440 




GO =GO+TRn).. 




/* GRAND TOTAL 


♦/QTST 450 




PSO =RS0*TR(I1*TR(I>,. 




/* SUM OF ROM TOTAL SQUARED 


♦/QTST 46C 




END,. 






QTST 47C 




00 J - 1 TO M,. 






QTST 480 




CSO =CSO»TCU»*TC(J),. 




/• SUM OF COLUMN TOTAL SQUARED */QTST *90 | 




END.. 






QTST 500 


Q 


=FM*GD-RSQ,. 






QTST 510 


IF G 


LT 1 




/* TEST FOP Q NEAR lERO 


♦/QTST 520 


THEN 


DO,. 

6RROR«'2',. 
GO TO FIN,. 
END,. 






OTST 530 
QTST 540 
OTST 550 
OTST 560 


/• 








*/QTST 570 


/* COMPUTE CCCHRAN Q TEST VALUE. 




*/QTST 580 


/« 








♦/QTST 590 


Q 


=*FM-1.0)*(FM*CSO-GO*GD1/IFH*GD-RSQ),. 


OTST 600 


NOF 


=M-1,. 




/* FIND DEGREES OF FREEDOM 


♦/QTST 610 


FIN.. 








QTST 620 


RETURN,. 






QTST 630 


.. 






/*ENO OF PROCEDURE QTST 


♦/OTST 640 



Purpose: 

QTST uses the Cochran Q-test to determine whether 
three or more matched groups of dichotomous data 
differ significantly. 

Usage: 

CALL QTST (A, N, M, Q, NDF); 

A(N,M) - BINARY FLOAT 

Given matrix of dichotomous data. Da- 
ta elements must be either or 1. 

N - BINARY FIXED 

Given number of sets in each group. 

M - BINARY FIXED 

Given number of groups. 

Q - BINARY FLOAT 

Resultant Cochran Q statistic. 

NDF - BINARY FIXED 

Resultant number of degrees of freedom. 



Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR=l - number of groups, M, is less than three 
and/or the number of sets, N, is less 
than or equal to one. 

ERR0R=2 - all values of matrix A are equal. 

Method: 

Described in S. Siegel, Nonpar ameteric Statistics 
for the Behavioral Sciences , McGraw-Hill, New 
York, 1956, chapter 7. 

Mathematical Background: 

This subroutine determines the Cochran Q-test 
statistic, given a matrix A of dichotomous data 
with n rows (sets) and m columns (groups). 
Row and column totals are calculated: 



m 



L. = ^ A.. 
' i = i « 



(row totals) 



(1) 



where i = 1, 2, . . . , n 



G.= T A.. 
J i = 1 '' 



(column totals) 



(2) 



where j = 1, 2, . . . , m 

The Cochran Q statistic is computed: 



(m-1) 



Q=- 



m ^ / m 



m 



j = l ^ \j = l ^ 



(3) 



^Z Li - E h 

i = 1 i = 1 



The degrees of freedom are: 
d. f . = m - 1 



(4) 
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• Subroutine RANK 











RANK.. 






RANK in 1 


/*******«**«*********1:«**1,t;t:t^»^1HLttt***********t****ti*m** 


********«««*«/RANK 20 


/* 






*/RANK 30 


/* TO RANK A VECTOR OF VALUES. 






*/RANK 40 


/* 






•/RANK 50' 


/#********'******»***#*******^t**^i*::t:»:»^^■tt:**»*1l****'^*******l^**ttt*****^/t^Am. 60 1 


PROCEDURE (A.R.N),. 






R ANK 70 


DECLARE 






RANK 80 


ERPQC EXTERNAL CHARACTERIl), 






RANK 90 


1A(«),R(*],EQUAL,P',$MALL,X) 






RANK 100 


BINARY FLOAT, 






RANK 110 


(I.J.NI 






RANK 120 


BINARY FIXED,, 






RANK 130 


/* 






♦/RANK 140 


ERROR='0',. 






RANK 150 


DO 1 = 1 TO N,. 






RANK 160 


RID =C.C,. 






RANK 170 


ENDt . 






RANK 180 


IF N LE I 






RANK 190 


THEN DO,. /• VECTOR LENGTH 


IS 


ONE OR 


LeSS*/RANK 200. 


ERROR='l',. 






RANK 210 


GO TO FIN,. 






RANK 220 


END, . 






RANK 230 


/* 






*/RANK 240 


/* FIND RANK OF DATA 






*/RANK 2 50 


/* 






*/RANK 260 


00 I = 1 TO N,. 






RANK 270 


/* 






*/PANK 280 


/* TEST WHETHER DATA POINT IS ALREADY RANKED 






♦/RANK 290 


/* 






♦/RANK 300 


IF R(n LE 






RANK 310 


THEN 00,. 






RANK 320 


SMALL=0.O,. 






RANK 330 


EOUAL=0.0,. 






RANK 340 


X =A(n,. /» DATA POINT TO 


BE 


RANKED 


♦/RANK 350 


DO J = 1 TO N,. 






RANK 360 


IF A (J) LT X 






RANK 370 


/* 






♦/RANK 380 


/* COUNT NUMBER OF DATA POINTS WHICH ARE SMALLER 






♦/RANK 390 


/* 






♦/RANK 400 


THEN SMALL=SMALL*I.O,. 






RANK 410 


ELSE IF A(J)= X 






RANK 420 


THEN DO,. 






RANK 430 


/* 






♦/RANK 440 


/* COUNT NUMBER OF DATA POINTS WHICH ARE EQUAL 






♦/RANK 450 


/* 






♦/RANK 460 


E0UAL=EQUAL+1,. 






RANK 470 


R(J) =-1.0,. 






RANK 480 


END,. 






RANK 490 


END,. 






RANK 500 


IF EQUAL LE l.O /* TEST FOR TIE 






♦/RANK 510 


/* 






♦/RANK 520 


/* STORE RANK OF DATA POINT WHERE NO TIE 






*/PANK 530 


/* 






♦/RANK 540 


THEN Ptl) =SMALL+l.O,. 






RANK 550 


/* 






♦/RANK 560 


/« CALCULATE RANK OF TIED DATA POINTS 






♦/RANK 570 


/* 






♦/RANK 580 


ELSE P =SMALL+(EQUAL+1.0)/2.0,. 






RANK 590 


DO J = 1 TO N,. 






RANK 600 


IF R)J)= -1.0 






FANK 610 


THEN R(J) =P,. 






RANK 620 


END,. 






RANK 630 


END,. 






RANK 640 


END, . 






RANK 650 


FIN.. 






RANK 660 


RETURN,. 






RANK 670 


ENDt. /*END OF PROCEDURE RANK 


*/RANK 680 



following constitutes the possible error condition 
that may be detected: 

ERR0R=1 - vector length one or less. 
Method: 

Vector is searched for successively larger elements. 
If ties occur, they are located and their rank value 
is computed. For example, if two values are tied 
for sixth rank, they are assigned a rank of 6.5 
(=(6+7) /2). 



Purpose: 

RANK ranks a vector of data. 

Usage: 

CALL RANK (A, R, N) ; 



A(N) 
R(N) 



N 



BINARY FLOAT 

Given vector containing data to be rank- 
ed. 

BINARY FLOAT 

Resultant vector containing the ranks of 
the data in A. Smallest value is ranked 
1; largest is ranked N. Ties are as- 
signed the average of the tied ranks. 
BINARY FIXED 
Given number of values. 



Remarks: 

If no errors are detected in the processir^ of data, 
the error indicator, ERROR, is set to zero. The 
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Subroutine SRNK 



SRNK.. 




SRNK 10 


/******« 


t****»***»***»************************************»*****<l'*****/Sr(UK 20 i 


/* 




*/SRNK 30 


/» 


TO TEST CORRELATION BETWEEN TWO VARIABLES BV MEANS OF 


*/SRNK 40 


/* 


SPEARMAN RANK CORRELATION COEFFICIENT. 


«/SRNK 50 


/* 




*/SRNK 60 


/*»««**««»*«««» «««**«««**«*******«*«««* «***«*««******«****««*«»«*«** 


•*/SRNK 70 


PROCEDURE 1A.B,R1,R2,N,RS,T,N0F,NR),. 


SRNK 80 


DECLARE 


SRNK 90 




tAl*l.ei*),Rl(*),R2(»».RS,T,0,X,Y,TSA,rse.FNN) 


SRNK IOC 




BINARY FLOAT, 


SRNK 110 




(KT,N,NDF,NR) 


SRNK 120 




BINARY FIXED, 


SRNK 130 




ERROR EXTERNAL CHARACTER U),. 


SRNK 140 


f* 




*/SRNK 150 


FNN 


*N*N*N-N,. 


SRNK 160 


NOF 


=0,. 


SRNK 170 


T 


=0.0,. 


SRNK 180 


RS 


=0.0,. 


SRNK 190 


ERROR^'O',. 


SRNK 200 




00 1=1 TO N,. 


SRNK 210 




RKI) =0,. 


SRNK 220 




R2(I) =C,. 


SRNK 230 




END,. 


SRNK 240 


IF N 


LE 1 /* NUMBER OF OBSERVATIONS IS 


•/SRNK 250 


THEN 


00,. /•LESS THAN OR EQUAL TO ONE. 


•/SRNK 260 




ERROR* •!•,. 


SRNK 270 




GO TO FIN,. 


SRNK 280 




END.. 


SRNK 290 


/* 




•/SRNK 300 


/• 


DETERMINE WHETHER DATA IS RANKED. 


•/SRNK 310 


/• 




•/SRNK 320 


IF NR N£ I 


SRNK 330 


/* 




♦/SRNK 340 


/* 


RANK DATA IN A AND B VECTORS AND ASSIGN TIED OBSERVATIONS 


•/SRNK 350 


/* 


AVERAGE OF TIED RANKS. 


•/SRNK 360 


/* 




•/SRNK 370 


THEN 


00.. 


SRNK 380 




CALL RANK (A.Rl.N).. 


SRNK 390 




CALL RANK 1B,R2,N),. 


SRNK 400 




END,. 


SRNK 410 


ELSE 


DO.. 


SRNK 420 




00 1 = 1 TO N,. /*■ MOVE RANKED DATA 


•/SRNK 430 




pui)=An),. 


SRNK 440 




R2(I)-B(I),. 


SRNK 450 




END,. 


SRNK 460 




END,. 


SRNK 470 


/* 




•/SRNK 480 


/* 


COMPUTE SUM OF SQUARES OF RANK DIFFERENCES. 


•/SRNK 490 


/* 




•/SRNK 500 





=0.. 


SRNK 510 




DO I = 1 TO N,. 


SRNK 52C 




=0+(RUll-R2»III**2,. 


SRNK 530 




END,. 


SRNK 540 


KT 


-1,. 


SRNK 530 


CALL 


TIE (R1.N,KT,TSA),. /• COMPUTE TIED SCORE INDEX 


• /SRNK 560 


IF ERR0R=*2* /♦ ALL RANKS FOR ONE VARIABLE 


•/SRNK 570 


THEN 


/* ARE EQUAL 


•/SRNK 580 


SIO.. 




SRNK 590 




DO,. /♦ ALL RANKS FOR ONE VARIABLE 


•/SRNK 600 




ERR0R-*3*>< /* ARE EQUAL 


*/SRHK 610 




GO TO FI-N,. 


SRNK 620 




END, . 


SRNK 630 


CALL 


TIE <R2,N,KT.TSB}t. 


SRNK 640 


IF EPP0R=«2' 


SRNK 650 


THEN 


GO TO SIO,. 


SRNK 660 


/• 




•/SRNK 670 


/• 


COMPUTE SPEARMAN RANK CORRELATION COEFFICIENT 


•/SRNK 680 


/• 




•/SRNK 690 


IF TSA NE AND TSB NE 


SRNK 700 


THEN 


00.. 


SRNK 710 




X =FNN/12.0-TSA,. 


SRNK 720 




Y =X*TSA-TS8,. 


SRNK 730 




RS =(X*Y-D)/(2.0*(SQRTIX*Y)n,. 


SRNK 740 




£N0.. 


SRNK 750 


ELSE 


RS =1.0-6.0*D/FNN,. 


SRNK 760 


/• 




•/SRNK 770 


/* 


COMPUTE T AND DEGREES OF FREEDOM IF N IS 10 OR LARGER 


*/SRNK 780 


/* 




•/SRNK 790 


IF N 


GE 10 


SRNK 800 


THEN 


DO,. 


SRNK 810 




T =RS*S0RT((N-2.0)/(l.0-RS*RSI),. 


SRNK 820 




NDF =N-2 . . 


SRNK 830 




END,. 


SRNK 840 


ELSE 


EPR0R='2'.. /* SAMPLE SIZE LESS THAN 10 


•/SRNK 850 


FIN.. 




SRNK 860 


RETURN.. 


SRNK 870 


END, 


/•END OF PROCEDURE SRNK 


•/SRNK 860 



R1(N) 

R2(N) 

N 
RS 



NDF 



Ml - 



Given vector containing the observa- 
tions for the second variable. 
BINARY FLOAT 

Resultant vector containii^ rank of the 
data in vector A. 
BINARY FLOAT 

Resultant vector containing rank of the 
data in vector B. 
BINARY FIXED 
Given number of observations. 
BINARY FLOAT 

Resultant variable containing the Spear- 
man rank correlation coefficients. 
BINARY FLOAT 

Resultant variable containii^ the mea- 
sure to be used to test the significance 
of RS. 

BINARY FIXED 

Resultant variable containing the num- 
ber of degrees of freedom. 
BINARY FIXED 
Given code containing the foUowii^: 

- for raw data in vectors A and B. 

1 - for the rank of data in vectors 

A and B. 



Remarks: 



Purpose: 



If no errors are detected in the processing of data, 
the error Indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR=l - number of observations less than or 
equal to one. If this condition exists, 
Rl and R2 will contain invalid values. 

ERR0R=2 - sample size less than 10. (T and NDF 
are not computed tC this condition is 
detected. ) 

ERROR=3 - All ranks for one variable are equal. 

Procedures and function procedures required: 
RANK 
TIE 



SRNK tests the correlation between two variables 
by means of the Spearman rank correlation coeffi- 
cient. 

Usage: 

CALL SRNK (A, B, Rl, R2, N, RS, T, NDF, NR); 

A(N) - BINARY FLOAT 

Given vector containing the observa- 
tions for the first variable. 

B(N) - BINARY FLOAT 



Method: 

Described in S. Slegel, Nonparametric Statistics 
for the Behavioral Sciences, McGraw-Hill, New 
York, 1956, chapter 9. 

Mathematical Background: 

This subroutine measures the correlation between 
two variables by means of the Spearman rank cor- 
relation coefficient, given two vectors of n obser- 
vations for the variables. 
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The observations on each variable are ranked 
from 1 to n. Tied observations are assigned the 
average of the tied ranks. 

The sum of squares of rank differences is cal- 
culated: 



D = ^ (A. - B.) 



i = 1 



i 1 



where: 



(1) 



The significance of r^ can be measured by the 
statistic: 



N-2 



t = r 



s \/ , 2 
1-r 

s 



The degrees of freedom are: 

d. f. = N-2 



(7) 



(8) 



Aj = first ranked vector 



B. = second ranked vector 



n = number of ranks 
A correction factor for ties is obtained: 



a ^^ 



III 
12 



^'^'- 



12 



over variable A 



over variable B 



(2) 



where t = number of observations tied for a given 
rank. 

The Spearman rank correlation coefficient is 
then computed for the following two cases: 



(1) if T and T, are zero 
a b 



r = 1 

s 



6D 



3 
n -n 



(3) 



(2) if T and/or T, are not zero 
a b 



X+Y-D 



'■i 



2JXY 



where: 



(4) 



N -N 

X= - T 

12 a 



(5) 



3 

N -N 

Y= -T 

12 b 



(6) 



232 Statistics—Nonparametric Statistics 



• Subroutine TIE 



Remarks: 



TIE.. 


TIE 


10- 


/«***•**»*«**♦••*«***«•♦••»•*»**»«*«**« ♦»********************»*»***«*«/TIE 


20 


/♦ 


♦/TIE 


30 


/* 


TO CALCULATE CORRELATION FACTOR DUE TO TIES. */TIE 


40 


/• 


•/TIE 


50 


/***•*••***«****♦*****♦*••» »**»***»*«**«******#***»****»****»******»**/TI 6 


60 


PROCEDURE (R,H,KT,T1,. TIE 


70 


DECLAPE TIE 


80 




<B(«).T,X,Y,CT) TIE 


90 




BINARY FLOAT, • TIE 


100 




ERROR EXTERNAL CHARACTERt 1 ) , TIE 


110 




(1,IN0,KT,N) TIE 


120 




BINARY FIXED,. TIE 


130 


/• 


•/TIE 


140 


ERROR='C«». TIE 


150 


IF N 


LE I TIE 


160 


THEN 


DO.. /* VECTOR LENGTH IS ONE OR LESS^/TIE 


170 




ERRtlRs'l',. TIE 


180 




GO TO FIN,. TIE 


190 




END,. TIE 


200 


T 


-0.0,. /* INITIALIZATION •/TIE 


210 


Y 


-0.0,. TIE 


220 


SIC. 


TIE 


230 


X 


=N+l,. TIE 


2*0 


I NO 


-0,. TIE 


250 




DO I ' 1 TO N,. /• FIND NEXT LARGEST RANK «/TIE 


260 




IF R(l) GT Y AND R(l> LT X TIE 


270 




THEN DO,. TIE 


280 




X .RIII,. TIE 


290 




INO -INO*!,. TIE 


300 




END,. TIE 


310 




END,. TIE 


320 


/• 


• /TIE 


330 


/* 


IF ALL RANKS HAVE BEEN TESTED PETURN •/TIE 


340 


/* 


•/TIE 


350 


IF IND NE TIE 


360 


THEN 


DC. TIE 


370 




V =X,. TIE 


380 




CT -0.0,. TIE 


390 




00 I - 1 TO N,. /• COUNT TIES •/TIE 


400 




IF R(ll= X TIE 


410 




THEN CT =CT+l.O,. TIE 


420 




END,. TIE 


430 




IF CT NE 0.0 TIE 


440 




THEN DO,. TIE 


450 




IF KT= 1 TIE 


460 




THEN T -T^KT^CT^CT-CTI/ia.O,. TIE 


470 




ELSE T -T+CT»(CT-I. 01/2.0,. TIE 


480 




END,. TIE 


490 




GO TO SIO,. TIE 


500 




END,. TIE 


510 


FIN.. 




520 


IF CT-N /* «LL RANKS FOR ONE VARIABLE VTIE 


530 


THEN 


ERR0R-'2',. /• ARE EOUAL •/TIE 


540 


RETURN,. TIE 


550 


END* 


/•END OF PROCEDURE TIE •/TIE 


560 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERR0R=1 - vector length one or less. 
ERR0R=2 - all ranks of one variable are equal. 

Method: 

Vector is searched for successively larger ranks. 
Ties are counted and correction factor 1 or 2 
summed. 



Purpose: 

TIE calculates correction factor due to ties. 

Usage: 

CALL TIE (R, N, KT, T); 

R(N) - BINARY FLOAT 

Given vector of ranks containing values 

from 1 to N. 
N - BINARY FIXED 

Given number of ranked values. 
KT - BINARY FIXED 

Given code for calculation of correction 

factor 

1 - solve equation 1 

2 - solve equation 2 
T - BINARY FLOAT 

Resultant variable containing correction 

factor 

Equation 1 T=SUM(CT**3-CT)/12 
Equation 2 T=SUM(CT*(CT-l)/2) 

where CT is the number of observations 

tied for a given rank. 
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• Subroutine TWAV 



NR - 



**»***m*****t*****ti,$n,tm^^^^t********: 



TMAV 

TO TEST WHETHER A NUMBER OF SAMPLES ARE FROM THE SAME */THAV 
POPULATION BY THE FRIEDMAN THO-HAY ANALYSIS OF VARIANCE 



PROCEDURE (A,R,NtH,XR,NDF.NR)t. 
DECLARE 

ERROR EXTERNAL CHARACTER {!», 

(A(*,*).R(*.«),UA(M),HB(MltXft.FH»FNM.RTSQI 

BINARY FLOAT, 

{ItNR.NfMTNDFl 

BINARY FIXED,. 

ERROR='0«,. 

XR -0.0,. 

NOF -0, . 

IF M LT 3 OR N LE I 

THEN DO,. 

ERROR- '1',. 

GO TO FIN,. 

END,. 



70 



/* THE NUMBER OF CASES IS LESS 
' THAN 3 OR THE NUMBER OF 



•/THAV 

»/TWAV 

*/THAV 

♦/THAV 
■*/TNAV 
TWAV 
TWAV 100 
TWAV 110 
TWAV 120 
TWAV 130 
TWAV 1*0 
TWAV 150 

♦/THAV 160 

THAV 170 

TWAV 180 

TWAV 190 

/THAV 200 

/TWAV 210 



FM 



=M, 



FNM =N^(M*1), 
IF NR NE 1 

THEN 00, . 



RANK DATA IN EACH GROUP AND ASSIGN TIED OBSERVATIONS 
AVERAGE OF TIED RANK. 





00 I 


=1 10 N,. 

00 J = 1 TO M,. 

WA(J|.»II,J),. 

END,. 




CALL 


RANK (HA, MB, HI,. 
00 J = 1 10 H,. 
R(I,J)-HB(J),. 
END,. 




END, 




END, 






ELSE DO,. 







=1 TO N,. 

00 J = 1 TO M,. 

R(I,J»=AII,J),. 

ENDt. 



CALCULATE SUM OF SQUARES OF SUMS OF RANKS 

RTSQ =0.0,. 

DO I = 1 TO M,. 
WAdl-O.O,. 

DO J = 1 TO N,. 

WAin-HA(I)tR(J,I),. 

END,. 
RTSQ =RTSQ+HA(I)^HA(I),. 
END.. 



CALCULATE FRIEDMAN TEST VALUE, XR, AND DEGREES OF FREEDOM 
■fl2.0/<FN^FNH)MRTSQ-3.0^FNH,. 



RETURN,. 
END*. 



/♦ GROUPS IS LESS THAN OR EQUAL^/THAV 220 
/♦ TO ONE ♦/THAV 230 

THAV 2«0 
THAV 250 
TWAV 260 
TWAV 270 
TWAV 280 
♦/TWAV 290 
♦/THAV 300 
♦/TWAV 310 
♦/TWAV 320 
THAV 330 
THAV 340 
THAV 350 
TWAV 360 
THAV 370 
THAV 380 
THAV 390 
TWAV 400 
THAV 410 
TWAV 420 
TWAV 430 
TWAV 440 
THAV 450 
THAV 460 
THAV 470 
THAV 480 
THAV 490 
♦/THAV 500 
♦/THAV 510 
♦/THAV 520 
THAV 530 
THAV 540 
TWAV 550 
TWAV 560 
TWAV 570 
TWAV 580 
THAV 590 
THAV 600 
♦/THAV 610 
♦/THAV 620 
♦/THAV 630 
THAV 640 
THAV 650 
THAV 660 
THAV 670 
♦/THAV 680 



/*€N0 OF PROCEDURE THAV 



BINARY FIXED 
Given code: 

for raw data in A; 

1 for ranks of the data in A. 



Remarks: 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The ' 
following constitutes the possible error condition 
that may be detected: 

ERROR=l - number of groups less than or equal to 
one, or number of cases less than three. 

Subroutines and function subroutines required: 

RANK 

Method: 

Described in S. Siegel, Nonparametric Statistics 
for the Behavioral Sciences. McGraw-Hill, New 
York, 1956, chapter 7. 

Mathematical Background: 

This subroutine determines the Friedman two-way 
analysis of variance statistic, given a matrix A 
with n rows (groups) and m columns (cases). Data 
in each group is ranked from 1 to m. Tied observa- 
tions are assigned the average of the tied ranks. 
The sum of ranks is calculated: 



Purpose: 

TWAV tests whether a number of samples are from 
the same population, by the Friedman two-way 
analysis of variance test. 

Usage: 

CALL TWAV (A, R, N, M, XR, NDF, NR); 

A(N,M) - BINARY FLOAT 

Given matrix of original data. 
R(N,M) - BINARY FLOAT 

Resultant matrix of the ranks of the data, 
N - BINARY FIXED 

Given nimaber of groups, 
M - BINARY FIXED 

Given number of cases in each group. 
XR - BINARY FLOAT 

Resultant Friedman statistic. 
NDF - BINARY FIXED 

Resultant number of degrees of freedom. 



R. = Z A 
J i = l '^ 

Friedman's statistic is then computed: 



(1) 



2 12 

X-,= — 
r nm 



m 



^^ L (R) -3n(m+l) 
j = 1 ■' 



The degrees of freedom are: 
d. f . = m - 1 



(2) 



(3) 



234 Statistics—Nonparametric Statistics 



• Subroutine UTST 



»**********•«■«*•**««***** 



UTST.. *^^5^ 

/**•*«»*«**•• **********«««»*»»**********-»****************************/'JTST 

f^ •/UTST 

/• TO TEST WHETHER TWO INDEPENDENT GROUPS ARE FROH THE SAKE •/UTST 
/♦ POPULATION 8V MEANS OF A MANN-WHITNEV U-TEST. '/UTST 

/♦ 

/««««***•*«****•*••••«••**••*•*•••«' 

PROCEDURE (A.R.N1.N2«U.Z).. 
DECLARE 

ERROR EXTERNAL CHARACTER (Dt 

(A(«)tR(*)»UtZ.R2tUPtTStS,FN.FN2.PNX) 

BINARY FLOAT. 

IItKT.N.Nl«N2) 

BINARY FIXEOf. 



/• 



ERROR='0' 



/• Nl IS GREATER THAN N2 



RANK SCORES FROH BOTH GROUPS TOGETHER IN ASCENDING ORDER 
AND ASSIGN TIED OBSERVATIONS AVERAGE OF TIED RANKS 



N =:=N1+N2.. 

00 I=t TO Nt. 

Rd) '=0f. 

END.. 
U -0.0. . 

Z =0.0,. 

IF Nl GT N2 
THEN DC. 

ERROR=*li«. 

GO TO FIN,. 

END,. 
IF N LE 2 
THEN 00,. 

ERR0R=»2»,. 

GO TO FIN,. 

END,. 
CALL RANK IA*R*NI,. 
IF Nl LE I OR N2 LE 1 
THEN 00,. 

ERROR* '2',. 

GO TO FIN,. 

END,. 
R2 >0.0,. 

00 I - Nl+1 TO N» 

R2 =R2+RtI),. 

END,. 

>Nl*N2t. 



•/UTST 60 
»*****/UTST 70 
UTST 80 
UTST 90 
UTST 100 
UTST 110 
UTST 120 
UTST 130 
UTST 1*0 
•/UTST 150 
UTST 160 
•/UTST 170 
♦/UTST 180 
•/UTST 190 
•/UTST 200 
UTST 210 
UTST 220 
UTST 230 
UTST 240 
UTST 250 
UTST 260 
UTST 270 
UTST 2 BO 
•/UTST 290 
UTST 300 
UTST 310 
UTST 320 
COMBINED SAMPLE LESS THAN OR*/UTST 330 



/* EQUAL TO TWO. 



/* SUM RANKS IN LARGE GROUP 



FNX 
FN 
FN2 
UP 

u 



«N, 

-N2.. 

-FNX*FN2^nFN2*1.01/2.0)-R2,- /• CALCULATE U 

■FNX-UP,. 



•/UTST 3*0 

UTST 350 

UTST 360 

UTST 370 

UTST 380 

UTST 390 

UTST *00 

UTST *I0 

UTST *20 

•/UTST *30 

UTST **0 

UTST *50 

UTST *60 

UTST *70 

UTST *80 

UTST *90 

•/UTST 500 

UTST 510 

UTST 520 

UTST 530 

♦/UTST 5*0 

UTST 550 

UTST 560 

•/UTST 570 

UTST 580 

•/UTST 590 

•/UTST 600 

UTST 610 

UTST 620 

UTST 630 

SQRTnFNX/IFN^(FN-l.0)»l^M(FN*FN*FN-FNI/l2.l-TSH,,UTST 6*0 

UTST 650 
UTST 660 
UTST 670 
•/UTST 680 
•/UTST 690 
•/UTST 700 
•/UTST TIO 



/• TEST FOR Nl LESS THAN 10 



/* COMPUTE STANDARD OEVIATION 



ALL RANKS FOR ONE VARIABLE 
ARE EQUAL 



IF UP LT U 
THEN U -UP,. 
IF Nl GE 10 
THEN 00*. 

KT *l,. 

CALL TIE (R.N.KT,TS> 

IF ERROR-* 2» 

THEN DO*. 

ERROR-***,. 
GO TO FIN,. 
END,. 

IF TS NE 

THEN S 

ELSE S -SQRT(FNX«(FN+1.0)/12.0> 

Z »|U-FNX^0.5J/S,. 

END*. 
ELSE ERR0R-*3*,. /* NUMBER OF CASES IN THE 

FIN.. /* SMALLER GROUP IS LESS THAN 

RETURN,. /* TEN 

END,. /•END OF PROCEDURE UTST 



Purpose: 

UTST tests whether two independent groups are from 
the same population, by means of Mann-Whitney 

U-test 

Usage: 

CALL UTST (A, R, Nl, N2, U, Z); 



U - BINARY FLOAT 

Resultant statistic used to test homogeneity 
of the two groups, 

Z - BINARY FLOAT 

Resultant measure for determining the sig- 
nificance of U in terms of normal distribution 
(if Nl is less than 10, Z is set to zero). 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR=l - Nl greater than N2. 

ERROR=2 - Combined samples less than or equal to 

two. 
ERROR=3 - number of cases in the smaller group is 

less than 10 (in tiiis case Z is set to zero) . 
ERR0R=4 - all ranks for one variable are equal. 

Subroutines and function subroutines required: 

RANK 
TIE 

Method: 

Described in S, Siegel, Nonparametric Statistics for 
the Behavioral Sciences , McGraw-Hill, New York, 
1956, chapter 6. 

Mathematical Background: 

This subroutine tests whether two independent 
groups are from the same population, by means of 
the Mann-Whitney U-test, given an input vector A 
with the smaller group preceding the larger group. 
The scores for both groups are ranked together in 
ascending order. Tied observations are assigned 
the average of the tied ranks. 

The sum of ranks in the larger group, R2, is 
calculated. The U statistic is then computed as 
follows: 



A(N) - BINARY FLOAT 

Given vector of cases, consisting of two inde^ 

pendent groups. Smaller group precedes 

larger group. N = Nl + N2. 
R(N) - BINARY FLOAT 

Resultant vector of ranks. Smallest value is 

ranked 1; largest is ranked N. Ties are 

assigned average of tied ranks. 
Nl - BINARY FIXED 

Given number of cases in smaller group, 
N2 - BINARY FIXED 

Given nimiber of cases in larger group. 



n2(n +1) 
U'=^'^2^ 2 ^2 



(1) 



where: 



n = number of cases in smaller group 



n = number of cases in larger group 

6i 



u=^^2 



U' 
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if U' < U, set U = U' (2) 

A correction factor for ties is obtained: 



• Subroutine WTST 






(3) 



where t = number of observat ions tied for a given 
rank. 

The standard deviation is computed for two cases: 
(1) if T = 



^ 12 



(4) 



(2) if T > 



"l°2 
>N(N-1) 



N^ - N 
12 



- T 



(5) 



where N = total number of cases (n + n ) 



The measure used to determine the significance of U 
is then calculated: 



Z = 



U -X 



(6) 



where X = mean 



Nl N2 



Z is set to zero if Nl is less than 10. 



****************:t**************»* 



********m*»*****:f ******** 



TO TEST DEGREE OF ASSOCIATION AMONG A NUHBER OF VARIABLES 
BY THE KENDALL COEFFICIENT OF CONCORDANCE. 

*********************************** t:**************t******»******** 
PROCEDURE (A,R.N,M,W»CS,NDF,NR).. 
DECLARE 

ERROR EXTERNAL CHARACTER tl), 

(A(*,*),R(*,*),MA(M1,W8(H),H,CS,SM,S,TI,T,FN,FM) 
BINARY FLOAT, 





(I,J,KT,M,N,NDF,NR) 




BINARY FIXED*. 


ERROR='0»,- 




DO 1=1 TO N,. 




DO J=l TO M,. 




Rd.Jl -0,. 




END,. 




END,. 


H 


-O.O,. 


CS 


•0.0,. 


NDF 


*0,. 


IF N 


LT 3 OR H LT 3 


THEN 


00,. 




EPROP='l',. 




GO TO FIN,. 




END,. 



/♦ ALL RANKS FOR ONE VARIABLE 
/* ARE EQUAL 



/* NUMBER OF VARIABLES (N) OR 
/* NUMBER OF CASES IM> IS LESS 
/* THAN 3 

DETERMINE WHETHER DATA IS RANKED. IF IT HAS NOT BEEN DONE 
RANK DATA FOR ALL VARIABLES ASSIGNING TIED OBSERVATIONS 
AVERAGE OF TIED RANKS AND COMPUTE CORRECTION FOR TIED SCORES 

= 1,. 

DO I = 1 TO N,. 
IF NR NE 1 
THEN DO,. 

DO J = 1 TO M,. 
WAIJ)=Jl(I,J},. 
END,. 
CALL RANK (HA,MB,M},. 
END, . 
ELSE DO,. 

DO J = 1 TO M,. 
WB(J)=A<I,J),. 
END,. 
END,. 
CALL TIE (HB,M,KT,TI),. 
IF ERR0R='2' 
THEN 00,. 

ERR0R=»3',. 
GO TO FIN,. 
END, . 
T =T+TI,. 

DO J = 1 TO M,. 
R(I,J)=W8IJ),. 
END,. 
END,. 
=N,. 



CALCULATE VECTOR SUMS AND COMPUTE MEANS OF SUNS 

DO J = 1 TO M,. 
HA)J)=O.C,. 

DO I = I TO N,. 

HA(J)=WA(J}4^R(I,J),. 

END,. 
SH ^SH+WAIJI,. 
END. . 
=SM/FM,. 

COMPUTE THE SUM OF SQUARES OF DEVIATION 

=0,. 

DO J = I TO M,. 

S =S*IWA( J)-SMI»*2,. 

END.. 

=S/({(FN*FN)*IFM*FM»FM-FM)/12.0)-FN*T>,, 

COMPUTE DEGREES OF FREEDOM AND CHI-SQUARE IF H IS OVER 7 



IF M GT 7 




THEN DO, , 




CS =FN*(FM- 


.0)*W.. 


NDF =M-1,. 




END,. 




ELSE ERRPR='2',. 




RETURN,. 




END,. 





/* NUMBER OF CASES (M» IS LESS 
/* THAN OR EQUAL TO 7 



/*ENO OF PROCEDURE HTST 



WTST 

**/MTST 

•/HTST 

*/HTST 

*/MTST 

*/HTST 

**/WTST 

HTST 

HTST 

HTST 100 

WTST 110 

HTST 120 

WTST 130 

HTST 140 

*/HTST 150 

HTST 160 

HTST 170 

HTST 180 

WTST 190 

WTST 200 

WTST 210 

WTST 220 

WTST 230 

HTST 240 

HTST 250 

WTST 260 

*/HTST 270 

*/WTST 2 

•/HTST 290 

•/HTST 300 

*/HTST 310 

•/WTST 320 

•/HTST 330 

♦/WTST 340 

WTST 350 

HTST 360 

HTST 370 

HTST 360 

WTST 390 

WTST 400 

HTST 410 

WTST 420 

WTST 430 

HTST 44C 

WTST 450 

WTST 460 

HTST 470 

HTST 480 

HTST 490 

HTST 500 

WTST 510 

HTST 520 

•/HTST 530 

•/HTST 540 

HTST 550 

HTST 560 

HTST 570 

HTST 580 

HTST 590 

HTST 600 

HTST 610 

HTST 620 

HTST 630 

♦/WTST 640 

♦/HTST 650 

♦/HTST 660 

HTST 670 

HTST 680 

HTST 690 

HTST TOO 

HTST 710 

HTST 720 

HTST 730 

HTST 740 

♦/HTST 750 

♦/HTST 760 

♦/HTST 770 

WTST 780 

HTST 790 

WTST 800 

HTST 810 

HTST 820 

♦/HTST 830 

♦/HTST 840 

♦/HTST 850 

HTST 860 

WTST 870 

HTST 880 

HTST 890 

HTST 900 

♦/HTST 910 

♦/HTST 920 

HTST 930 

HTST 940 

♦/HTST 950 



Purpose: 

WTST measures the degree of association among a 
number of variables by the Kendall coefficient of 
concordance. 

Usage: 

CALL WTST (A, R, N, M, W, CS, NDF, NR); 

A(N,M) - BINARY FLOAT 

Given matrix of original data. 
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R(N,M) - 



N 
M 
W 

CS 

NDF 

NR 



BINARY FLOAT 

Resultant matrix, N by M, of tiie ranks 

of the data. Smallest value is ranked 1; 

largest is ranked M. Ties are assigned 

average of tied ranks. The data is 

ranked by rows. 

BINARY FIXED 

Given number of variables. 

BINARY FIXED 

Given number of cases. 

BINARY FLOAT 

Resultant variable containing Kendall 

coefficient of concordance. 

BINARY FLOAT 

Resultant variable containing the value 

of chi-square. 

BINARY FIXED 

Resultant variable containii^ number of 

degrees of freedom. 

BINARY FIXED 

Given code containing the following: 

for raw data in A. 

1 for the rank of data in A. 



A correction fector for ties is obtained: 



rr, T' t - t 

T = i; 



i=l 



12 



(1) 



where t = number of observations tied for a given 
rank. 

Sums of ranks are calculated: 



Y. = y; R .. 

J i = l '' 



(2) 



where j = 1, 2, ... , m. 

From these, the mean of sums of ranks is found: 



m 



L Y. 



R^i^ 



m 



(3) 



Remarks: 



The sum of squares of deviations is derived: 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERROR = 1 - number of variables, N, or number of 
cases, M, less than three. 

ERROR = 2 - number of cases, M, less than or 

equal to seven (CS and NDF are set to 
zero. ) 

ERROR = 3 - all ranks for one variable are equal. 

Subroutines and function subroutines are required: 

RANK 
TIE 

Method: 

Described in S. Siegel, Nonparametric Statistics for 
the Behavioral Sciences , McGraw-Hill, New York, 
1956, chapter 6. 

Mathematical Background: 

This subroutine computes the Kendall coefficient of 
concordance, given a matrix A of n rows (variables) 
and m columns (cases). The observations on all 
variables are ranked from 1 to m. Tied observa- 
tions are assigned the average of the tied ranks. 



m 



s= E (Y,-R) 



j = l 



J 



(4) 



The Kendall coefficient of concordance is then 
computed: 



W 



^ n ^ (m^ - m) - n T 



(5) 



For m larger than 7, chi-square is: 

X^ = n (m - 1) W 
The degrees of freedom are: 
d.f. =n- 1 



(6) 



(7) 
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Subroutine HTES 





HTES.. 




/,,*..,„».„...,„.,„„..„„„„„„„,„„,„„„,,^^,^,^^^^^^^^^^^HTES 10 


',t rt ^S^'^"'-*" ™^ KRUSKAL-BALIIS H-STATISTIC FROM THE RANKS 


*/HTES 30 
*/HTES 40 


/<■ »EnSenT SAMPLES """^" '" OBTAINED FROM THREE OR MORE INOE- 


*/HTES 50 
•/HTES 60 


"•pRoc^s^Rr::":;:;:":::"*"""*"""——*"" •"••••"'Hifi ii\ 


DECLARE 


Hits 90 


C4(*),R(*»,H,S,SUMR,T,XK,XN» 

BINARY FLOAT, 

(M(«),I,J,K,L,N.NSI 

BINARY FIXED. 

ERROR EXTERNAL CHARACTER 11),. 


HTES 100 
HTES 110 
HTES 120 
HTES 130 
HTES 140 
HTES 150 


H fo'^c""'^'" ^* 'N'TIALIZATION 

IF NS LT 3' 


*/HTES 160 
*/HTES 170 


HTES 180 


ELSE oS!?'"'^'" '* ^" ^'"*°'* INDICATOR 


HTES 190 
•/HTES 200 


N =0,. 


HTES 210 


HTES 220 


DO 1 = I TO NS,, /♦ CALCULATE TOTAL NUMBER OF 


•/HTES 230 


i*" "<I» LE /* CASES IN ALL SAMPLES 
THEN 00 f • 

EPR0R='3',, 

GO TO SIC. 

END,. 
N =NtM(I),. 
END,. 
XN =N,. 


♦/HTES 240 
HTES 250 
HTES 260 
HTES 270 


HTES 280 
HTES 290 


HTES 300 


/* 


HTES 310 


/• RAMK DATA FROM ALL SAMPLES IN ASCENDING ORDER A"0 ASSIGN 


•/HTES 320 
•/HTES 330 


/" TIED OBSERVATIONS AVERAGE OF TIED RANKS 
CALL RAMK (A,R,N),. 


•/HTES 340 


•/HTES 350 

HTES 360 


S =C,. 
J =0, . 


•/HTES 370 


HTES 360 


00 I = I TO NS,. 

K =Hni,. 

XK =K,. 

SUMP =e.c,. 


HTES 390 
HTES 400 
HTES 410 


HTES 420 
HTES 430 


DO L = 1 TO K,. /* SUM RANKS FOR EACH SAMPLE 


•/HTES 440 


J =JH,. 

SUMP "SOMR+RIJJ,. 

END,. 
S =S*SUMR*SUMR/XK,. 
END,. 


HTES 450 
HTES 460 


HTES 470 
HTES 480 


HTES 490 


/* CALCULATE H, UNCORRECTED FOR TIES 


•/HTES 500 
•/HTES 510 


H ="12.0*S)/(XN*XN*XNt ) -3.0*1 XN* 11.. 


•/HTES 520 
HTES 530 


/* COMPUTE CORRECTION FACTOR FOR TIES 


•/HTES 540 
•/HTES 55C 


K =1, . 


•/HTES 560 


CALL TIE tR,N.K,Tl,. 


HTES 570 


IF T = CO OR ERR0R='«2' 


HTES 580 


THEN GO TO SIO,. 


HTES 590 


ELSE 00.. 


HTES 600 


^^ S =l.C-((12.0*T)/tXN**3-XNH,. 


HTES 610 
HTES 620 


/* CORRECT H FOR TIES 


*/HTES 630 




•/HTES 640 


h =H/S,. 


•/HTES 650 


ENDt . 


HTES 660 


END,. 


HTES 670 


510.. 


HTES 680 


RETURN.. 


HTES 690 


^^°'* /*ENO OF PROCEDURE HTES 


HTES 700 
•/HTES 710 



Ptirpore: 

HTES calculates the Kruskal-Wallis H-statistic 
froir 'che ranks of observations obtained from three 
or more independent samples. 

Usage: 

CALL HTES (A, R, M, NS, H); 

A(N) - BINARY FLOAT 

Given i^ector of observed data stored 
columnwise. la other words, ihe data 
from the first sample, second, t!ii.-d, etc.^ 
are stored in consecutive locations of vec- 
tor A. N=M(1)+ M(2)+ . . . + M(NS) (that is , 
the total number of cases) 

R(N) - BINARY FLOAT 

Resultant vector containing the ranks of 
data of vector A. The smallest value is 
ranked one, and the largest is ranked N. 



Ties are assigned the average of the tied 

ranks. 
M - BINARY FIXED 

Given vector of length NS containing the 

number of cases in each sample. 
NS - BINARY FIXED 

Given variable containing ti<e number of 

samples. 
H - BINARY FLOAT 

Resultant variable containii^ the value of 

H-statistic. 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERR OR =1 - number of samples, NS, less than 

three. If this condition exists, R will 

contain invalid values. 
ERR0R=2 - all ranks for one variable are equal. 
ERR0R=3 - the number of cases in one of the 

samples is less than or equal to zero. 

If this condition exists, R will contain 

invalid values. 

Subroutines and function subroutines required: 

TIE 
RANK 

Method: 
Refer to: 

The computational procedures are described in 
S. Siegel, Nonparametric Statistics for the Behav- 
ioral Sciences . McGraw Hill, New York, 1956, 
chapter 8. 

Mathematical Background: 

From the data in vector A, the ranks are computed 
by the subroutine RANK and stored in vector R ac- 
cording to ascending values of the cases, with ties 
assigned the average of the tied ranks. The ranks 
are summed for each sample, and the H-statistic is 
calculated from the formula: 



H = 



where: 



NS 9 

12 !^ SUMR ^ 

N(N+1) .^^ M.' 



1 -I 



-3(N+1) 



(1) 



N = total number of cases 



238 Statistics— Nonparametric Statistics 



SUMRj = sum of ranks for the i-tii sample 
Mi = number of cases in the i-th sample 
NS = the number of samples 

H is corrected for ties, if present, using the value 
of T obtained from procedure TIE. The correction 
formula is: 



H 



H 



corrected 



uncorrected 
12T 

N^ -N 



(2) 



where: 



-V (t -t) 

12 



T=E 



■, summed over all samples 



t = number of tied observations in a group 

H is approximately distributed as x^ with (NS-1) de- 
grees of freedom, If the number of cases in each 
group is not too small (not less than five). 



Distribution Functions 



• Subroutine NDTR 



NOTR . . 


NDTR 


10 


/«« ********4r*** «««««**«******«*«»**»*«««««*«*«««*«**««««« ««,««««»«** *(I*/|^QXR 


2C 


/* 


*/NDTR 


30 


/* COMPUTES Y=P(X)=THE PROBABILITY THAT THE RANDOM VARIABLE U, 


*/NDTR 


AO 


/• DISTRIBUTED NORMALLY 10,1) IS LESS THAN OR EQUAL TO X. FIX) 


,*/NDTR 


50 


/* THE ORDINATE OF THE NQRHAL DENSITY tT X, IS ALSO COMPUTED. 


*/NOTR 


60 


/* 


♦/MDTR 


70 


/»«*««**«*«**«*»«*«** *****4i4i»*««L«««« ***««««*«*****««***** ***«*«*******/M(}TR 


80 


PROCEDURE tX.P.O),. 


NDTR 


9C 


DECLARE 


NOTt 


ICO 


(DtT.P.X.AX) FLOAT BINARY,. 


NDTR 


110 


AX sABSIX),. /• CALC. PROB. P £ DENSITY 


•/NOTR 


120 


T =I.OEO/{1.0EO*.2 316419EO*AX1,. 


NDTR 


130 


=0.3989423EC*EXP(-X*X/2.CEC),. 


NOTR 


140 


P =1.0E0-0*T*(I { (1.330 274E0*T-1. 8212 56E0)*T*1.7B14T 8E0 J*T- 


NOTR 


150 


0.356 5638) "T+C. 31938 15E0),. 


NOTR 


160 


IF X LT /* X < 


*/NOTR 


170 


THEN P=1.0E0-P,. /* COMPLEMENT P«OB, P 


*/NDTR 


180 


RETURN,. 


NOTR 


190 


END,. /* END OF PROCEDURE NOTR 


*/NDTB 


200 



Purpose: 

NDTR computes Y=P(x) , the probability that the 
random available X, distributed normally (0 , 1), is 
less than or equal to x. f(x) , the ordinate of the 
normal density at x, is also computed. 

Usage: 

CALL NDTR (X, P, D); 

X - BINARY FLOAT 

Given variable containing the scalar for which 

P(x) is computed. 
P - BINARY FLOAT 

Resultant variable containing probability. 
D - BINARY FLOAT 

Resultant variable containing density. 

Method: 
Refer to: 



C. Hastings, Approximations for Digital Compu- 
ters . Princeton University Press, Princeton, 
N.J. , 1955. 

M. Abramowitz and I. A. Stegun, Handbook of 
Mathematical Functions . Dover Publications, fiic. , 
N. Y. , equation 26. 2. 17. 

Mathematical Backgroimd: 

This subroutine computes y = P(x) = Prob pc ^ x), 
where X is a random variable distributed normally 
with mean zero and variance one. 

The following approximation is used: 

5 
P (X) = 1 - f(x) X) a.w^ X a^O 
i =1 ^ 
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where: 

w = 1/(1 + px) 

f(x) = exp (-x^/2) / 'slW 

P = 0.2316419 



a, = 0.3193815 
a. = -0.3565638 



• Subroutine BDTR 



ag = 1.781478 



-1,821256 



a. = 1.330274 





The maximum error is 7(10 ); f(x) is also pre- 
sented in output. 



60TR.. 










BDTR 10 


/*Mt***it****.*******»****'>em^*»»*»»^ifn*****M***mm9****m**m*m-*»n******m**/ZQjfi, 20 1 












•/BOTB 30 




BOTB COMPUTES P(XI ■ PROBABILITY 


THAT 


THE 


RANDOM VARIABLE 


*/BDTR *0 




DISTRIBUTED ACCORDING TO THE BETA DISTRIBUTION WITH PARA- 


*/80TR 50 




METERS A AND 6, IS LESS THAN OR 


EQUAL 


TO 


X. FIA.B.X), THE 


*/BOTR 60 




ORDINATE OF THE BETA DENSITY AT 


X, IS 


ALSO COMPUTED. 


•/BOTR 70 












•/BDTR 80 


/«««**•«*«*«*«**««»«**•**««*««««««****«« 


«*««*«««« 


***•********«««»«*« 


**/BOTR 90 


PROCEDURE (X.&,B,P,OI ,. 








BDTR 100 


DECLARE 








BDTR 110 




(XXtOLXX,0LLX.AA,B8.Gl.G2.G3tG4. 


JOfPP 


XO. 


FF.FN,XI,SS,CC, 


BDTR 120 




RR.OLBETAI eiNARY(53), 








BOTR 130 




(X,A»B.P.D,XS.OFtDUMHY) BINARY* 








80TR 140 




ID BINARY FIXED. 








BOTR 150 




ERROR EXTERNAL CHARACTERU 1 . . 








BOTR 160 


IF X 


LT Oft X GT 1 /* 


TEST 


THE 


VALUE OF X 


•/BDTR 170 


THEN 


DO, . 

EPROR='l',. 
GO TO SIG,. 
END.. 








BDTR 180 
80TR 190 
BDTR 200 
BDTR 210 


IF A 


LT .*9999 OR B LT .'vg'jgg /* 


TEST 


THE 


VALUES OF A AND 8 


•/BOTR 220 


OR A 


GT lE+5 OR 8 GT IE*5 








8DTP 230 


THEN 


UO,. 
FRR0R='2',. 








BDTR 240 
BDTR 250 


SIO.. 


D,P =-lE*75,. 
GO TO sue. 
END,. 








BOTR 260 
BDTR 270 
BOTR 2B0 
8DTR 290 


AA 


=A,. /* 


COMPUTE 


L0G1BETA(A,6)> 


•/BOTR 300 


Bb 


=B,. 








BDTR 310 


CALL 


LGAM(AA,G1) ,. 








BDTP 320 


CALL 


LGAH(BB.G2).. 








BDTR 330 


CALL 


LGAM(AA*BB.G3)t. 








8DTR 340 


0LBETA=G1*G2-G3,. 








BOTB 350 


IF X 


LE XE-8 /• 


TEST 


FOR 


X NEAR 0.0 


•/BDTR 360 


THEN 


DO,. 

P =0,. 

IF A LT I 

THEN 








BDTR 370 
BDTR 380 
BDTR 390 
80TR 400 


S20.. 


DOt. 

D =IE*75,. 
GO TO S13C,. 
END.. 
ELSE IF A = 1 
THEN 








BDTR 410 
BDTR 420 
8DTR 430 
BDTR 440 
BDTR 450 
BDTR 460 
BOTR 470 


S3C.. 


DO,. 

00 =-OLBETA.. 
IF DO GT -1.58E+2 
THEN DO.. 

D sEXPIOD),. 

GO TO S13C,. 

END.. 
ELSE GO TO $40,. 
END,. 
ELSE 








BOTR 480 
BDTR 490 
80TR 500 
BOTR 510 
BOTR 520 
BDTR 530 
BOTR 540 
BOTR 550 
BDTR 560 
BDTR 570 
BOTR 580 


S'.C. 


DO,. 

D =0.. 
GO TO SUO,. 
END.. 
END,. 








BDTR 590 
BOTR 600 
BDTR 610 
BDTR 620 
BOTR 630 
BDTR 640 


IF I 


-X LE lE-8 /* 


TEST 


FOR 


X NEAR l.O 


•/BDTR 650 


THEN 


00.. 

P =1.. 

IF 6 LT 1 

THEN GO TO S20,. 

ELSE IF B=l 

THEN CO TO S30,. 

ELSE GO TO S4C.. 
END.. 








BOTR 660 
BDTR 670 
BOTR 680 
BDTR 690 
BOTR 700 
BOTR 710 
BOTR 720 
BDTR 730 


XX 


=X,. /« 


SET PROGRAM PARAMETERS 


•/BOTH 740 


OLXX 


=LOG)XX). . 








BDTR 750 


DLlX 


=L0G(1-XX»,. 








BDTR 760 


XD 


=XX/( 1-XX) ,. 








BDTR 770 


ID 


=Ci . 








BOTR 780 


DD 


'=(ia-l}*DLXX*(66-ll*DLlX-0LBETA, 


/* 


COMPUTE ORDINATE 


»/BOTR 790 


IF DD GT I.6e£»-2 








BOTR BOO 


THEN 


DO,. 

D =IE>75,. 

GC TO S50,. 
END,. 








BOTB 810 
BOTR 820 
BOTR 830 
BDTR 840 


ELSE 


IF DD LE -1.68E+2 
THEN DO,. 

D =C,. 

GO TO S5C,. 

END,. 








BOTR 850 
BDTR 860 
BOTB 870 
BOTR 880 
BDTR 890 





=EXP10D),. 








BOTR 900 


S50.. 










BDTR 910 


IF ass(a-ii LE lE-8 /• 


A OR 


B BOTH WITHIN lE-8 OF 


1«/B0TR 920 


THEN 


IF ARS(B-11 LE lE-8 
THEN DO,. 

P =X,. 
GO TO S13C,. 
END,. 
ELSE DO,. 

PP =66*0L1X, , 
IF PP LE 1.68e+2 
THEN DO.. 

P =1,. 

GO TC S130,. 

END,. 
ELSE JO,. 

P =1-EXP(PP),. 

GO TO S120.. 

END,. 
END.. 








BOTR 930 
BDTR 940 
BDTR 950 
BOTR 960 
BDTR 970 
BOTR 980 
BOTR 990 
BOTR 1000 
BOTRIOID 
8DTR1020 
BDTR1030 
BOTR 1040 
B0TR105C 
BOTR 1060 
BOTR 1070 
6OTRI08O 
BDTR 1090 


IF ABS(B-l) LE lE-8 








BDTRllCO 


THEN 


DO.. 

PP =&A«OLXX,. 
IF PP LE -1.68E*2 
THEN DO,. 

P =C,. 

GO TO S130.. 

END,. 
ELSE DO,. 

P =EXP)PP».. 

GO TO SI 20,. 

END,. 
END,. 








BDTR 1 110 
B0TR112C 
BDTRU3C 
BDTR 1140 
8DTRU50 
BDTR1I60 
60TP1170 

eoTRueo 

B0TR119C 
BDTR 1200 
BDTR I 2 10 
B0TR122C 
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IF A 


GT IQOC /* TEST FOR A OR B GREATER 


*/aOTR 1.230 


THEN 


00,. /* THAN 1000 


*/B0TR12^0 




XS =2*AA/X0.. 


BDTR1250 




Of =2*BB,. 


B0TRU60 




CALL CDTfi(XS, Of ,P, DUMMY),. 


BDTR1270 




P =1-P,. 


B0TR1280 




GO TO S14C,. 


80TR1290 




ENO,. 


B0TB1300 


If B 


GT 1000 


6DTR1310 


THEN 


DO,. 


BDTR1320 




XS =2*6B*X0,. 


e0TR1330 




Of =2*AA,. 


R0TR1340 




CALL COTR)XS,OF,P,DUMHY),. 


60TR1350 




60 TO S140,. 


6DTP1360 




END,. 


BDTR1370 


If X 


LE .5 /* SELECT PARAMETERS FOR CON- 


•/B0TR1380 


THEN 


IF AA LE I /• TINUEO FRACTION COMPUTATION 


*/B0TO1390 




THEN 00,. 


eOTRl400 




RR =AA*1,. 


eOTRl^lO 




GO TO S6C,. 


eOTfil420 




END,. 


eOTRl430 




ELSE 00,. 


BDTR I 4*0 




RR =AA,. 


8DTR1450 


S60.. 




BDTR I 460 




DD =(RR-l)-tRR+8e-l)*XX«EXP(DLXX/5)*2,. 


60TR147C 




If DO LE C 


BDTR1480 




THEN GO TO SSO,. 


BDTRI490 




ELSE GO TO S9C,. 


80TR150C 




ENO,. 


BDTR1510 


IF 66 LE I 


BDTR 1520 


THEN 


00,. 


B0TR1530 




RR =BB*-1,. 


BDTR1540 




GO TO S70,. 


80TR1550 




ENO,. 


80TR1560 


PR 


=63,. 


B0TR1570 


S7Q., 




BDTR 15 80 


00 


=(RR-ll-lAA*RR-l)«ll-XX)*£XP(0LlX/5)t2,. 


B0TR1590 


If 00 LE 


B0TR1600 


THEN 


GO TO S90,. 


BDTR1610 


sac. 




80TR1620 


ID 


= 1,. 


60TRIft30 


FF 


=DLIX,. 


BDTR 1640 


DLIX 


=OLXX,. 


BDTR 1650 


OLXX 


=ff ,. 


B0TR1660 


xo 


=1/X0,. 


B0TR1670 


FF 


=AA,. 


B0TR1680 


AA 


=35,. 


B0rR1690 


68 


=FF,. 


B0TR170C 


G2 


=G1,. 


80TR1710 


S9C. . 




eDTP1720 


FF 


=0. . 


80TR1730 


IF AA LE 1 /* TEST FOR A LESS THAN 1 


•/BDTR 1740 


THEN 


00,. 


6DTR1750 




CALL LCAM(AAtL,G4) t . 


BDTR 1760 




DO =AA*0LXX*6e*0LlX+G3-G2-G4,. 


B0TR1770 




If DO GT -l.6e£+2 


60TR1780 




THEN ff=FF*EXP(OOI,. 


eOTR1790 




AA =AA+1,. 


BDTR1800 




END.. 


B0TR1810 


FN 


=aAt8B-l,. /* COMPUTE P USING CONTINUED 


*/ BDTR 1820 


RR 


=afl-l.. /» FRACTION EXPANSION 


• /■BDTR1830 


SS 


={{(8B-80)»(RR*80»)/((RR*2»8C-1(*)RR*2*80»)>*XO,. 


BDTR1840 




DO XI=79 TO 1 BY -1,. 


80TH1850 




DO =l(XI«(FN+Xn)/{(RR + 2*XI + l)*(RR*2«Xl)))*XO, . 


B0TR1860 




CC =( ((BB-XI)»(RR+Xin/((RR*2»XI-l)*(RR*2*XI)»)«XO, . 


B0TR187C 




SS =CC/(l+00/(l-SS)),. 


BDTfilBeO 




END,. 


8DTR1890 


ss 


=l/(l-SS).. 


B0TR190C 


IF ss LE 


B0TR1910 


THEN 


GO TO sue 


B0TR1920 


CALL 


LGAMtAAtee.Gl).. 


BDTR1930 


CALL 


LGAM(AA*1.G4),. 


BDTR 1940 


PP 


=G1-G2-GA*AA*0LXX+1BB-1)«0L1X>L0G(SS).. 


B0TR1950 


If PP LE -1.68Et2 


B0TR1960 


TH£^ 


DC. 


e0T9197O 




PP =FF,. 


BDTR 1980 




GO TO SICO,. 


60TR1990 




END,. 


BDTR 2 000 


PP 


=EXP(PP)*FF,. 


eDTR20lO 


SlOC. 




e0TR2O20 


If 


GT 


B0TR203C 


THEN PP=l-PPt. 


8DTP2040 


P 


=PP.. 


BDTR2050 


IF P LT /* SET ERROR INDICATOR 


*/B0TR206O 


THEN If ABS(P» GT lE-7 


60TR2070 




THEN GO TO SllC. 


8DTR2080 




ELSE DC,. 


BDTR2090 




P =C,. 


&DTR2100 




GO TO S130,. 


BDTR2nO 




END,. 


BOTR2120 


ELSE If P GT 1 


BOTft2130 




THEN IF ABStl-Pl GT lE-7 


B0TR21M 




THEN 


B0TR215O 


SllO.. 




eDTR2160 




DO,. 


BDTR2170 




ERR0R=«3»,. 


B0TR21B0 




P =*IE*75,. 


B0TR2190 




GO TO S140.. 


BOTR2200 




ENO.. 


B0TR221O 




ELSE DO.. 


BDTR 2220 




P =1,. 


BDTR 2 230 




GO TO 5130*. 


80 TR 2 240 




END.. 


BDTR2250 




ELSE 


B0TR2260 


S12C.. 




BOTR2270 




If P LE lE-8 


BOTR2280 




THEN DO,. 


BDTR 2 290 




P »0,. 


8DTR23O0 




GO TO S130,. 


B0TR2310 




END,. 


B0TR2320 




ELSE If 1-P LE lE-8 


B0TR2330 




THEN P-l,. 


60TR2340 


S13C. . 




B0TR2350 




ERROR^'O*,. 


BDTR2360 


S14C.. 




80TR2370 


RETURN,. 


B0TR23B0 


ENO 


, . /* ENO OF PROCEDURE BDTR 


•/B0TR239O 



Purpose: 

BDTR computes P(x) = probability that the random 
variable X, distributed according to the beta dis- 
tribution with parameters A and B, is less than or 



equal to x. f (A, B, X), the ordinate of the beta 
density of X, is also computed. 

Usage: 

CALL BDTR (X, A, B, P, D); 

X - BINARY FLOAT 

Given variable containing the scalar for which 

P(x) is computed. 
A -BINARY FLOAT 

Given variable containing the beta distribution 

parameter. 
B -BINARY FLOAT 

Given variable containing the beta distribution 

parameter. 
P -BINARY FLOAT 

Resultant variable containing the probability. 
D - BINARY FLOAT 

Resultant variable containing the density. 

Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following constitute the possible error conditions 
that may be detected: 

ERR0R=1 - invalid value of X. (X<0 or X> 1) 
ERR0R=2 - invalid value of A or B (A or B < . 5,or 

A or B> 10^). 

If either of the above conditions exists, 

the values of P and D are set to -1. E75. 
ERR0R=3 - Invalid output (P<0 or P > 1). If this 

condition exists, the value of P is set to 

1.E75. 

Subroutines and function subroutines required: 

CDTR 
LGAM 
NDTR 

Method: 

Refer to: 

R. E. Bargmann and S. P. Ghosh, "Statistical 
Description Programs for a Computer Language", 
IBM Research Report RC-1094, 1963. 
M. Abramowltz and L A. Stegun, Handbook of 
Mathematical Fimctions . U. S. Department of 
Commerce, National Bureau of Standards Applied 
Mathematics Series, 1966. 

Mathematical Background: 

This subroutine computes P=Ijj. (m,n)=Prob (X^x), 
where X is a random variable following the beta 
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distribution with degrees of freedom (contlauous 
parameters) m and n. For computation to take 
place, Os.x^l, 0. 5Sm:£ lO''"^, and 0, 5 ^n^lO'*'^. 
D, the ordinate of the beta density at x, is also pre- 
sented in the output. 



For s X < 1, I (m, n) may be written as: 



A. 

l^ (m, n) = / f (m, n, y) dy 



where: 

f (m, n, y) 



m-l„ n-l 

■ y (1-y) 



B(m,n) 



(1) 



]x(m,n) can be reduced to a binominal partial sum 
that can be evaluated by means of a continued frac- 
tion expansion. 

Let N = m+n-1 and r = m-1. Then: 



I^(m,n)= 1^(1+1, N-r) 



i^ (ts-i. N-r) = x: Gy (1-x)^- 

U+ 1/ 



(2) 



r+1 „ ,N-r-l^ 
X (1-x) S 



where £ s ^ N 

S is a continued fraction, with 80 terms beii^ 
sufficient for the desired accuracy. 



1-1+ 1- 1+ 1- 



%0 %0 

1+ 1 



c. 



(N- i- r) (r+i) 



i (r + 2i - 1) (r + 2i) 1-x 
i (N+ i) 



i (r+2i+l) (r+ 2i) 1-x 



(3) 
(4) 
(5) 



The above continued fraction expansion of I^ (m,n) 
liolds for positive m and n (integers or nonintegers), 
^T s (m + n a 1), and r s (m s 1). fo order to 



fulfill these last two conditions, if m < 1, the follow- 
ing transformation must be made before computation 
of I^ (m,n) can take place: 

T / V r (m + n) m n 

^x("^'")= r(mVi)r(n) ^ (1-^) +I^(ni+l,n) 



(6) 



The quantities on the right-hand side of equation (6) 
are those that are computed. 

a is known that Ix(m,n) = Ij.^Cn.m). Thus, either 
of the two parameter sets indicated by this equation 
may be used in computing the beta integral. The 
parameter set selection is made by applying the 
following empirically derived rule: 

Let p and q be the degrees of freedom corre- 
sponding to z , where z =xifxS.5or (1-x) 
otherwise. If the quantity [(p-1) - (p+q-1) 
z °/^ + 2] is positive, use the parameter set 
corresponding to z. Otherwise, use the para- 
meter set corresponding to (1-z). 

-8 -8 

If ^x ^10 or £. 1-x ^10 , the approximation 

is made that x = or 1 respectively. P and D are 

then set according to the following table: 



^x ^10 
P = 



If: 



Then: 



.75 



A < 1 D = 10 

A = l D = l/B(m,n) 

A > 1 D =0 



s 1-x s 10- 
P = 1 

If: 



Then: 

B < 1 D =10 

B = 1 D =1/B(m,n) 

B > 1 D = 

-8 



If either m or n, or both are within 10 of 1, the 
beta integral is solved explicitly for m = 1, n = 1, 
or m = n = 1: 





E 


_ 




= 


1, 


B 


= 1 


= 


1, 


B 


f^l 


7^ 


1, 


B 


= 1 



Then: 



P=x 



P = 1 - (1 - X) 



P=x' 



m 
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If m or n is greater than 1000, the chl-square ap- 
proximation is used: 

/ 2 

z^ = 2m (l-x)/x is distributed as X with 2n 

degrees of freedom and P = 1 - P^ 2 (z j) for m > 
1000. 

2 
z = 2nx/ (1-x) is distributed as X with 2 m 

degrees of freedom and P = Py2 (zq) for n > 1000. 
If both m and n are greater than 1000, the approx- 
imation corresponding to Z]^ is used. 

The values of P very near zero or one may be some- 
what imprecise. To eliminate possible misinterpre- 
tation of results, if ^P ^10"^ or ^1-P ^10"°, 
P is set to or 1 respectively. 



Subroutine CDTR 



COTR.. 


CDTR 10 


/«««***«««*«««*«*««««*««»««««****«*****«**«****«««*««******«*««*******/CDTR 20 j 




*/CDTR 30 


/* COMPUTES PIX) " PROBABILITV THAT THE RANDOM VARIABLE U. 


•/CDTR 40 


/« DISTRIBUTED ACCORDING TO THE CHI-SOUARE DISTRIBUTION UITH G 


•/CDTR 50 


/• DEGREES OF FREEDOM, IS LESS THAN OR EQUAL TO X. FIG.X), THE 


•/CDTR 60 


/* ORDINATE OF THE CHI-SQUARE DENSITY AT X, IS ALSO COMPUTED. 


•/CDTR 70 




•/COTR 80 


/**««********«****«*********«**«*«****«*******•***«*****««««•****«**** /CDTR 90 1 


PROCEDURE fX.G.P.D),. 


COTR 100 


DECLARE 


COTR llO 


tXX,OLXX.DLX2,GG,G2,0LT3,THeTA,THPl,GLG2,0D,Tll,SER,CC,X2, 


CDTR 120 


XI,FACtTLOG.TERH,GTH.A2.A,B,C,DT2»DT3tTHPI) 


CDTR 130 


FLOAT BINARY (53), 


CDTR 140 


II.J,K,I3I FIXED BINARY, 


CDTJ< 150 


ERROR EXTERNAL CHARACTER (1), 


CDTR 160 


(X,G,D,SC,P,T1,T2,T3,0UHMYI FLOAT BINARY,. 


CDTR 170 


/• TEST INPUT VALIDITY 


•/COTR 180 


IF G LT .49999 OR G GT 2.E*05 OR X LT 


CDTR 190 


THEN 00,. /• SET ERROR INDICATOR 


•/CDTR 200 


0,P "-I.E75,. 


CDTR 210 


ERROR--!',. 


COTR 220 


GO TO S150,. 


COTR 230 


END.. 


CDTR 240 


ELSE IF X LE l.E-OS /• TEST FOR X NEAR ZERO 


•/COTR 250 


THEN DO,. /• SET P AHO DEPENDING 


•/CDTR 260 


P -0.0,. /* ON THE PARAMETER G 


•/COIR 270 


IF G LI 2.0 


CDTR 280 


THEN DO,. 


COTR 290 


-LETS,. 


CDTR 300 


GO TO S30,. 


CDTR 310 


END,. 


COTR 320 


ELSE IF G - 2.0 


CDTR 330 


THEN DO,. 


COIR 340 


.0.5,. 


COTR 350 


GO TO S30,. 


CDTR 360 


END,. 


COTR 370 


ELSE DO,. 


COTR 380 


D -0.0,. 


COIR 390 


GO TO S30,. 


COIR 400 


END*. 


CDTR 410 


END,. 


COTR 420 


ELSE IF X GT I.E»0» /• TEST FOR X > l.E»06 


•/COTR 430 


THEN DO,. /• SET P AND D 


•/COTR 440 


D -0.0,. 


COIR 450 


P -l.O,. 


COIR 460 


GO TO S30,. 


CDTR 470 


END,. 


COTR 480 


ELSE DO,. /« SET PROGRAM PARAMETERS 


•/CDTR 490 


XX .PRECISI0NIX,531,. 


CDTR 500 


DLXX -LOG(XX),. 


CDTR 510 


X2 .XX/2.E0,. 


CDTR 520 


DLX2 =L0G(X2),. 


CDTR 530 


GG -PRECISI0NIG,53),. 


CDTR 540 


G2 -GG/2.E0, . 


CDTR 550 


/• COMPUTE THE ORDINATE 


•/COTR 560 


CALL LGAHIG2,GLG2I,. 


CDTR 570 


00 .(G2-l.E01»DLXX-X2-G2».«931*7180559945EO-GLG2 


,. COTR 560 


IF DO LE 1.68E02 


CDTR 590 


THEN IF (0OM.68E021 LE 


COTR 600 


THEN DO,. 


COTR 610 


D -0.0. . 


COTR 620 


SIO.. 


COTR 630 


/• TEST FOR G > 1000 i X > 2000*/CDTR 640 1 


IF G LE 1000 


COTR 650 


THEN IF X GI 2000 


COTR 660 


THEN 


COTR 670 


S20.. 


CDTR 680 


DO,. 


CDTR 690 


P -t.O,. 


COTR 700 


S30.. 


CDTR 710 


ERROR-'OS. 


COTR 720 


GO TO SI 50,. 


CDTR 730 


END,. 


COTR 740 


ELSE 00.. 


CDTR 750 


/• COMPUTE THETA 


•/COTR 760 


K -FL00R(G2).. 


COTR 770 


THETA-G2-FL0AT 1K.53) , . 


CDTR 780 


GO TO S40,. 


COTR 790 


END,, 


COTR 800 


ELSE DO,. /* WILSON HILFERTY APPROX. 


•/CDTR 810 


A -L0G(XX/GG)/3.E0,. 


CDTR 820 


A -EXPIAI,. 


COTR 830 


B -2.E0/I9.E0*GG),. 


CDTR 840 


CSC -IA-1.E0>8I/SQRT<B),. 


COTR 850 


CALL NOTRISC.P, DUMMY),. 


CDTR 860 


GO TO S60,. 


CDTR 870 


END.. 


COTR 880 


END.. 


CDTR 890 


ELSE DO.. 


CDTR 900 


DD.D -EXPIDD).. 


COTR 910 


GO TO SIO.. 


CDTR 920 


END,. 


CDTR 930 


ELSE DO,. 


COTR 940 


D -1.E75,. 


COTR 950 


GO TO $10,. 


COTR 960 


END,. 


COTR 970 


ENO, . 


CDTR 980 


S40.. 


CDTR 990 


IF THETA LE l.E-8 


COTR 1000 


THEN THETA-O.EO,. 


COTRIOIO 


THPI -THETA+l.EO, . 


CDIR1020 


/• SELECT METHOD FOR 


•/CDTR 1030 


/» COMPUTING Tl 


•/CDTR 10 40 


IF THETA GT 


COTR 1050 


/• COMPUTE Tl FO 


•/COTR 1060 


/• THETA > «. X < OR - 10 


•/CDTR1070 


THEN IF XX LE 10. EO 


COTR 1080 


THEN DO. . 


CDTR 1090 


SER -X2*II.E0/THP1-X2/(THPI*I.E0)),. 


CDTRllOO 


J -1.. 


COTRIIIO 


CC -FLOATIJ.53).. 


CDTR 1120 


DO IT1.3 TO 30.. 


CDTR1130 


XI -FLOATIIT1.53).. 


C0TR1140 


CALL LGAMIXI.FAC).. 


CDTR1150 


TLOG -XI*DLX2-FAC-L0GIXI«THETA).. 


CDTR 11 60 


TERM =EXP(TLOG),. 


C0TR1170 


TERM =SIGN<CC)«AeS(TERM),. 


CDTRllBO 


SER -SER*TERM,. 


CDTR1190 


CC — CC. 


COTR 1200 


IF ABS{TERM) LT l.E-9 


CDTR1210 


THEN GO TO S80, . 


CDTR 1220 


END,. 


CDTR 1230 
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60 TO S90(. 






C0TRI24O 


END*. 






CDTR1250 


ELSE DO,. /• tl FOB THEI*>0 


AND 10<X<2000»/CDTR12«) 


A2 ~ -O.EO*. 






CDTR1270 


00 I-l TO 25,. 






C0TR128O 


XI •FL0«TII,S3I,. 






CDTRt290 


C«LL ieAH(THPl,GTHI.. 






CDTR1300 


Til — (13.EO*XXI/XI«THP1*IOCC13.EO»XX/XI) 


-GTH-LOGIXII 


,. CDTR 1310 


IF ITll«l.«aE02) GT 






C0TR1320 


THEN DO,. 






CDTR1330 


Til -EXFITllI,. 






CDTR1340 


A2 -«2*T11,. 






CDTR1350 


010,. 






CDTR 1360 


END,. 






C0TR1370 


«0 TO S130,. 






CDTR 1380 


END,. 






C0TR1390 


ELSE IF X2 GE 1.6SE02 






C0TR1400 


THEN DO,. /« CONFUTE Tl 


FOR 


THETA - 


*/COTR14l0 


Tl -1.0.. 






CDTR 1*20 


S50.. 






CDTR1430 


IF G G£ 2 /• SELECT APPRO. 


EXP. FOR P 


*/CDTR 1440 


THEN IF G GE ♦ 






COTR1450 


THEN DO,. 






C0TR1460 


/• CALC. FO* G 


> 0« - 4 


•/CDTR 1470 


/• AND < OR - 


100 




•/CDTR 1480 


DT3 -O.EO,. 






CDTR 1490 


00 I3«2 TO K,. 






C0TR1500 


THPl -FL0ATII3,53)*THETA,. 






CDTRISIO 


CALL LGAK (THPI.GTHI,. 






C0TR1520 


0LT3 .THPI»DLX2-DLXX-X2-GTH,. 






CDTR1530 


IF (DLT3+I,6aE02l GT 






C0TR1540 


THEN DT3 -0T3«EXP(0LT3I,. 






CDTR 1590 


END,. 






CDTR 1560 


T3 -DTS.. 






CDTR1570 


P -T1-T3-T3,. 






C0TR1580 


GO TO S60,. 






C0TR1590 


END,. 






CDTR 1600 


ELSE DO,. 






CDTR1610 


P -Tl,. 






C0TR1620 


S60.. 






C0TR1630 


IF P LT 






CDTR1640 


THEN IF ABSIPI LE l.E-T 






C0TR165O 


THEN 






CDTR 1660 


STO.. 






CDTR 1670 


DO,. 






C0TR1680 


P -0.0,. 






CDTR 1690 


GO TO S30,. 






C0TR1700 


END,. 






CDTRITIO 


ELSE GO TO S90.. 






CDTR 1720 


ELSE IF P GT 1,0 






C0TR1730 


THEN IF A0SI1.-P) GT l.E- 


-7 




CDTR 1740 


THEN GO TO S90,. 






CDTR1750 


ELSE GO TO S20,. 






C0TR1760 


ELSE GO TO SlOOf. 






CDTR 1770 


END,. 






COTR 1780 


ELSE GO TO Sl«5,. 






CDTR1790 


END,. 






CDTR 1800 


ELSE 00,. 






COTRIBIO 


T11,T1 =1.E0-EXPC-X2),. 






CDTR1820 


GO TO S50,, 






CDTR1830 


END,. 






COTR 1840 


S80.. 






COTR 18 50 


IF ISER) LE 






CDTR1860 


THEN GO TO S90, . 






C0TR1870 


ELSE DO,. 






CDTR1880 


CALL LGAH (THPl.GTH),. 






C0TR1890 


TLOG -THETA*DLX2»L0G(SER1-GTH,. 






CDTR 1900 


IF (TL0G+1.68E02) LE 






COTR 19 10 


THEN GO TO SllO,. 






CDTR 1920 


ELSE GO TO SL20, . 






CDTR 1930 


END,. 






C0TR194O 


S90.. 






COTR 1950 


ERRDR.'2',. /• SET ERROR INDICATOR 


•/CDTR 1960 


P -1.E75,. 






COTR 1970 


GO TO S150,. 






CDTR1980 


SIOO.. 






C0TR1990 


IF P LE l.E-8 






CDTR2000 


THEN GO TO STO,. 






COTR 20 10 


ELSE IF Cl.O-P) LE l.E-8 






CDTR2020 


THEN GO TO S20,. 






COTR2030 


ELSE GQ ID S30,, 






CDTR2040 


SllO.. 






C0TR2050 


Tl =0.0,. 






CDTR2060 


GO TO S50,. 






C0TR2070 


S120.. 






CDTR 20 80 


Til, 11 -EXPITLOGl,. 






CDTR2090 


GO TO S50,. 






C0TR2100 


S130.. 






COTR21I0 


A >1.0l2e2051tTHETA/156.EO-XX/312.EO,. 






C0TR2120 


B -ABS(A),. 






COTR2130 


C — X2«THPI»0LX2*L0G(B1-GTH-3.951243718581«E0, 






CDTR2140 


IF (O1.68E021 LE 






C0TR2150 


THEN DO,. 






CDTR2160 


C -CEO,. 






CDTR2170 


S140.. 






COTR 2.180 


C .A2«;,. 






COTR 2 190 


Tll.Tl -l.EO-C,. 






COTR2200 


GO TO S50, . 






CDTR2210 


END,. 






COTR2220 


ELSE IF A LT 






CDTR2230 


THEN 00,. 






C0TR2240 


C — EXPCCl,. 






CDTR2250 


GO TO S140,. 






COTR 2260 


END,. 






CDTR 2270 


ELSE IF A -0 






CDTR2280 


THEN DO,. 






C0TR2290 


C -O.EO,. 






C0TR2300 


GO TO SIM,. 






CDTR2310 


END.. 






CDTR2320 


ELSE 00,. 






CDTR233v 


C -EXPICI,. 






CDTR2340 


GO TO S140,. 






C0TR2350 


END,. 






CDTR2360 


S145.. 






C0TR2370 


CALL LGAH (THPl,GTH),. /»CCHPUTE P FOR 


0<G<2 


♦/COTR 2380 


0T2 -THETA*0LXX-X2-THPI*.693147I80559945E0-GTH,. 






C0TR2390 


IF (DT2+1.68E02) LE 






C0TR2400 


THEN DO,. /•CDHPUTE P FOR 


G 


> OR - 2 


•/CDTR2410 


P -Tl,. 






C0TR2420 


GO TO S60,. 






CDTR2430 


END,. 






C0TR2440 


ELSE DO,. 






CDTR2450 


DT2,T2 =EXP(0T21.. 






COTR 2460 


P -Tl+T2*T2,. 






C0TR2470 


GO TO S60,. 






CDTR2480 


END,. 






CDTR2490 


S150.. 






CDTR2500 


RETURN,. 






CDTR 2510 


END,. /« END OF PROCEDURE CDTR 


♦/CDTR2520 



Purpose: 

CDTR computes P(x) = the probabaity that the ran- 
dom variable X, distributed according to the chi- 
square distribution with G degrees of freedom, is 
less than or equal to x. f (G x), the ordinate of the 
chi-square density at x, is also computed. 

Usage: 

CALL CDTR (X, G, P, D); 



X 



G 



P 
D 



BINARY FLOAT 

Given random variable following the chi- 
square distribution. 
BINARY FLOAT 

Given variable contataing the number of 
degrees of freedom of the chi-square distri- 
bution. G is a continuous parameter such that 
.5 sG s2 (105). 
BINAKY FLOAT 

Resultant variable containing the probability. 
BINARY FLOAT 
Resultant variable containing the density. 



Remarks: 

If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. The 
following consitute the possible error conditions that 
may be detected: 

ERROR=l - invalid value of X. 

(X < 0) or invalid value of G. 

(G < .5 or G > 200,000) 

If this condition exists, the values of P 

and D are set to -1. E75. 
ERR0R=2 - invalid output (P < or P > 1) or the 

series Tl has failed to converge. If 

this condition exists, the values of P 

and D are set to -1. E75. 

Subroutines and function subroutines required: 

LGAM 
NDTR 

Method: 

For reference see: 

1. R. E. Bargmann and S. P. Ghosh, 
"Statistical Distribution Programs for a 
Computer Language", IBM Research 
Report RC- 10 94, 1963. 

2. M. Abramowltz and I. A. Stegun, Hand- 
book of Mathematical Functions U. S. 
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Department of Commerce, National 
Bureau of StancJards Applied Mathematics 
Series, 1966. 

Mathematical Background: 

This subroutine computes P=P(x)=Prob. (X sx), 
where X is a random variable following the x dis- 
tribution with continuous parameter g. X must be 
greater than or equal to zero and . 5 ^ g ^ 2 (10 ) for 
computation to take place. D, the ordinate of the 
X density at x, is also presented in the output. 

For X > 0, P(x) may be written as: 



P(x) = C f(g, y) dy 




(1) 



where: 



Hi.^-y''-'"h-^" 



2 



D=f(g,x) 

To evaluate the integral, we first define 



e = 



g 



2 "[I]' 

where -f-denotes the largest integer less than 
equal to-fr 9 is thus the fractional part of-f-. 



or 



Substitutii^ this expression into the integral and per- 
formu^ the proper reductions, we find: 



g; 

<g <2 

2 ig <4 

g 24 



Then; 
P(x) = Tl + T2 

P(x) = Tl 

P(x) = Tl - 2T3 



where: 



Tl 



A. 

J 



e -y/2 

2^''®r(i+e) 



dy 



T2 = f(2+2e,x) 

[f] 

T3 =Xf(2i+2e,x) 
i=2 



T2 and T3 may be evaluated directly using logs and 
antllogs. 

K 9 = ("1^ is an integer), Tl is easily evaluated as: 



Tl = 1 - e 



-x/2 



If 9 > , Tl can be expanded in the following infinite 
series: 



,9 



Tl =- 



r(l+8)|l+fc) 24-9 2!(3+e) 3!(4+e)" 



(2) 



where Z = — . 



This series is used in the range 10 <x ^10, 
and not more than 30 terms are necessary to ensure 
convergence within error bounds of 10" . 

For X > 10, 1-Tl is evaluated by the Euler- 
McLaurin formula up to third derivative terms 
(see Reference 2, equation 23, 1,30). One finds: 



N 



1 - Tl = / h(u) du 




(3) 



where: 
h(u) =- 

N 



rj;i+9) 



(2u) 

NX 



(1+9) 



-1 -Nx/2u 
u e 



N-1 



/ h(u) du = 52 ^ W +i^ (N) -h^' (N) 
u=0 



+ h'" /N) 

720 ^ ' 

(Note:h'=h'" =0 atO.) 

In order to achieve accuracy consistent with that 
obtained by the method of equation (2) , N=26 is 
used in equation (3). 

— 8 
If ^x ^10 , the approximation is made that 

x=0. P is set to 0, and D is set to 1.E75, . 5, or 

0, corresponding to g less than 2, equal to 2, or 

greater than 2 respectively. 

If g > 1000, Wilson and Hflferty's approximation 
is used. (-S-) 1/3 is anproximately normally dis- 
tributed wlm mean 1 --^ and variance-^ (see ref- 
erence 2, equation 26, 4. 14), Kg ^.loOO and 
X > 2000, or g > 1000 and x > 10^, P is set to 1. 

Since Tl may have an error of about 10" , values 
of P(x) very near zero or one may be somewhat 
imprecise. To eliminate possible misinterpretation 
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of results, if ^P(x) ^ 10"^ or ^1 -P(x) ^10"^, 
P(x) is set to or 1 respectively. 

The X^ distribution is a member of the gamma 
family of probability distributions. The general 
form for distributions of this class is: 



P (X) =/G(n,A, >l/;u) du 
^ 



G 

where 



G (n, a, ^; u) = (u-a)"""^ ^'(^-^)/y ^ yj^^ (n) ). 

This subroutine may, therefore, also be used to 
compute the probability integral from zero to x and 
the corresponding ordinate at x for any member of 
this gamma family by setting: 

X = 2(u-a) /^ andg = 2n 

Then P(x) will be the desired probability, and 
^^ will be the desired ordinate. 



• Subroutine NDTI 



NOTl 



NDTI.. 

COMPUTES X-P«*X(-1)(Y), THE ARGUMENT X SUCH THAT Y=P(X)=THE */NDTI 
PROBABILITY THAT THE RANDOM VARIABLE U. DISTRIBUTED NORMALLY */NDTI 
(0,1), IS LESS THAN OR EQUAL TO X. FIX) THE ORDINATE OF THE •/NDTI 
NORMAL DENSITY, AT X, IS ALSO COMPUTED. •/NDTI 

•/NDTI 

NDTI 



/• 



PROCEDURE(P,X,D),. 
DECLARE 

(P,X,D,T2,T) FLOAT BINARY, 

ERROR EXTERNAL CHARACTER U), 
ERROR-'O*,. 
X.O -0,. 
IF P LT 0.0 
THEN 
SIO.. 

DO,. 

ERROR- • 1 • , . 

GO TO S30,. 

END,. 
ELSE IF P - 0.0 

THEN 00, . 



90 



/* P < 0- -SET ERROR INHICATOR 



S20. 



— .999999E*74,. 



/* P » 0— SET X AND 



D =0.0,. 
GO TO S30,. 
END,. 
ELSE IF P GT I.O 

THEN GO TO SIO,- 
ELSE IF P = 1.0 

THEN DO,. /• p 

X =.999999E+74,. 
GO TO S20,. 
END,. 
ELSE 00,. 



=P,. 
IF D GT 0.5 



100 
NDTI 110 
NOti 120 
NDTI 130 
NOTI 140 
NDTI 150 
NDTI 160 
NOTI 170 
NOTl 180 

•/NDTI 190 
NOT J ?00 
NOTI 210 
NOTI 220 
NDTI 230 

•/NDTI 240 
NOTI 250 
NDTI 260 
NDTI 270 
NOTI 280 
NDTI 290 
NDTI 300 
/* P > 1— SET ERROR INDICATOR */NDTI 310 
NDTI 320 

♦/NDTI 330 
NOTI 340 
NOTI 350 
NOTI 360 

•/NOTI 370 
NDTI 380 
NOTI 390 

•/NOTI 400 

NDTI 410 

IN WRITE UP*/NOTI 420 

NDTI 430 

NOTI 440 



» 1— SET X AND D 



P > AND P < I 



/• COMPLEMENT P 
I =1.0-0,. 

/• CALC. EQUATION 
=LOGH.0/CD^0)l,. 
=SQRT(T21,. 



/* CALC. EQUATION 1 IN WRITE UP*/NDTI 450 



S30.. 

RETURN, 
END*. 



X =T-( 2^5 15517+0.802853*7+0. 010328*T2)/ 

( 1.0+1. 43278 8*T+0.189269*T2+0.001308*T 
•T2),. 

IF P LE 0.5 /• P < OR = .5 

THEN X =-Xr,/* NEGATE X 

/* CALCULATE DENSITY 

D =0.3989423*EXP(-X^X/2.0) ,. 

END,. 



/* END OF PROCEDURE NDTI 



NDTI 460 

NDTI 470 

NOTI 480 

♦/NDTI 490 

•/NDTI 500 

•/NDTI 510 

NDTI 520 

NDTI 530 

NDTI 540 

NDTI 550 

♦/NDTI 560 



Purpose: 

NDTI computes x = P" (y) such that y = P(x), the 
probability that the random variable X, distributed 
normally (0, 1) is less than or equal to x. f(x), the 
ordinate of the normal density at x, is also com- 
puted. 

Usage: 



CALL NDTI (P, X, D); 

P - BINARY FLOAT 

Given variable contaiaing the probability. 

X - BINARY FLOAT 

Resultant variable such that P=Y= the prob- 
ability that u, the random variable, is less 
than or equal to X. 

D - BINARY FLOAT 

Resultant variable containing the density 
f{X). 

Remarks: 



If no errors are detected in the processing of data, 
the error indicator, ERROR, is set to zero. How- 
ever, if P=0, X is set to -(10)'^^, and D is set to 
zero. If P=l, X is set to (10)'^'^ and D is set to 
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zero. The followiag constitutes the possible error 
condition that may be detected: 

ERROR=l - Invalid value of P. P is either less than 
zero or greater than one. 

Method: 
Refer to: 

C. Hastings, Approximations for Digital Computers , 
Princeton University Press, Princeton, N. J., 1955. 

M. Abramowitz and Stegun, I. A. Handbook of Math- 
ematical Functions , Dover Publications, Inc. , N. Y. , 
equation 26.2.23. 



Mathematical Background: 



,-1. 



This subroutine computes x = P *(y) such that 
y = P(x) = Probpc ^^x), where X is a random var- 
iable distributed normally with mean zero and 
variance one. That is, given P(x), the following is 
solved for x: 



P(x) 



X 

V27r -°= 



exp (-U /2) du 



The following approximation is used: 

2.3. 
X = w -^ a.w /^ b.w 
i=0 ^ i=0 ^ 

where: 



w =Vln (1/p^) (0<p^.5) 



(1) 



(2) 



a = 2. 515517 

a = 0. 802853 

a„ =0.010328 

b =1.432788 

b- = 0. 189269 

b =0.001308 

If P(x) is greater than 0. 5, 1-P(x) is used as p in 
(2) above, and the result of (1), x, is negated. The 
maximum error is 0.00045; f(x) is also calculated. 
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APPENDIX A; ACCURACY OF SUBROUTINES 



The subroutines in SSP can be broken down into 
three major categories from the standpoint of ac- 
curacy: 

(1) those having little or no effect on accuracy, 

(2) tifiose whose accuracy depends on the char- 
acteristics of the input data, and 

(3) those in which definite statements on accu- 
racy can be made. 

SUBROUTINES WITH LITTLE OR NO EFFECT ON 
ACCURACY 

The following subroutines do not materially affect 
the accuracy of the results, either because of the 
simple nature of the computation or because they do 
not modify the data. 



ABST 

BUND 

CHSQ 

HTES 

KLM2 

KRNK 

MOMN 

MPIT 

MPRM 

MTPI 

MSCG 

MSCS 

ORDR 

QTST 



RANK 

SRNK 

SUBM 

SBST 

TABl 

TAB2 

TALY 

TIE 

TRAC 

TTST 

TWAV 

UTST 

WTST 



SUBROUTINES WITH DATA-DEPENDENT ACCURACY 

The accuracy of the foUowii^ subroutines cannot be 
predicted because it depends on the characteristics 
of the input data and on the size of the problem. The 
programmer using these subroutines must be aware 
of the limitations dictated by numerical analysis 
considerations. It cannot be assumed that the re- 
sults are accurate simply because subroutine execu- 
tion is completed. 



ACFM/ACFE 


DFEC 


MATE 


AHM/AHIE 


DFEO 


MATU 


ALIM/ALIE 


DOTS 


MDLG 


APCI/APC2 


DMTX 


MDLS/MDRS 


APLL 


DSCR 


MDSB 


ASN 


EXSM 


MEAT 


AVAR 


FFT 


MEBS 


CANC 


FFTM 


MEST 


CORR 


FMFP 


MFG 


DERE 


KLMO 


MFGR 


DET3 


LOAD 


MFS 


DET5 


MAGS 


MFSB 



MGB1/MGB2 


POSV 


QH24 


MGDU 


PRTC 


QH32 


MIG 


PRTR 


QH48 


MINV 


QA2 


QHFG/QHFE/ 


MIS 


QA4 


QHSQ/QHSE 


MLSQ 


QA8 


QL2 


MLTR 


QA12 


QL4 


MMGG 


QA16 


QL8 


MMGS 


QA24 


QL12 


MMGT 


QATR 


QL16 


MMSS 


QG2 


QL24 


MSDU 


QG4 


QSF 


MSTU 


QG8 


QTFG/QTFE 


MVAT 


QG16 


RTF 


MVEB 


QG24 


RTFD 


MVST 


QG32 


SE15 


MVSU 


GH2 


SE35 


MVUB 


QH4 


SG13 /SE13 


PEC/PTC 


QH8 


STRG 


POST 


QH16 


VRMX 



SUBROUTINES WITH DEFINITE ACCURACY 
CHARACTERISTICS 

The subroutines in this section have accuracy char- 
acteristics that can be specified on an individual 
basis. The mathematical descriptions for many of 
these subroutines contain information on truncation 
error of a strictly theoretical nature. The actual 
implementation of these subroutines on System/360 
results in the accuracy noted in the following table. 
The standard reference for comparing the accuracy 
of these subroutines is M. Abramowltz, I.A. Stegun, 
Handbook of Mathematical Functions . National 
Bureau of Standards, Washington, D. C. , March 
1965. However, in certaia cases, other tables were 
used, as noted below. It should be remembered 
that in System/360 single-precision floating point, 
there are just over six significant figures. 

Maximum differences below are given in terms of 
number of decimal places (DP) and/or number of 
significant digits (SD) tiiat agree. The number of digits 
tabled should be considered when accuracy state- 
ments are viewed; that is, certain tables are given 
to only five places, whereas the algorithms used 
may be more accurate. ]h compiling maximum 
differences, the maximum was taken over the set of 
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points indicated in the table. The average difference 
was normally much smaller. 



The notation x = a (b) c implies that a, a + b, 
a + 2b, ... , c were the arguments (x) used. 



Name 


Functions 
calculated 


Functions 

checked 

with reference 


Range 

checked 

with reference 


Maximum 
difference 


BDTR 


p=Ix (a,b) 


Ix"^ (a.b) 
Tables by Leon 
H. Barter: New 
Tables of the 
Incomplete 
Gamma Function 
Ratio and of 
Percentage 
Points of the 
X ^ and Beta 
Distribution, 
1964 


p=. 0001, .0005 
a=l(l) 40 
b=5(5) 40 

p=. 0100, . 0500 
a= 2 (2) 10 
b=5(5)30 


correct to 5 DP 


CDTR 


y=Pg(x) 
where P is 
Uie X^ 
distribution 
function 
with para- 
meter g. 


y = Pg (X) 


x= . 001 (. 001) . 01; 
.01 (.01) 1.0; 
1.0 (.1)2.0; 
2. (. 2) 10. 0; 
10.0 (.5) 20.0; 
20 (1) 40 
40 (2) 76 

for 

g=l(l)30 


1 in the 5th DP 


CELI 
Complete 
elliptic 
1st integral 


K(k) 

(single 

precision) 


K(m); k ^m 
K(oO; k=sina 

(a in degrees) 


m=.01 (.01). 99 
a= 1(1)73 

a =74(1)86 


2 in 7tti SD 

2 in 7th SD 

3 in 7th SD 


K(k) 

(double 

precision) 


K(m); k = J m 

K(o; ); k = sin O! 
(o! in degrees) 


m= .01(.01).86 

m= .87 (.01) .96 
m= .97(.01).99 
a = 1(1)75 
a - 76(1)80 
a = 81(1)86 


I in 16th SD 

4 in 16th SD 

II in 16th SD 

1 in 16th SD 

2 in 16tii SD 
11 in 16th SD 
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Fimctions 


Range 




Name 


Functions 


checked 


checked 


Maximum 




calculated 


with reference 


with reference 


difference 




K(k) 


K(m); k-Jm 


m= .Ol(.Ol) .99 


2 in 7th SD 




with A = B = 1 

E(k) 

with A = 1 


K(a ); k = sin a 


a = 1(1)73 


2 in 7ih SD 




(a in degrees) 


a = 74(1)86 


3 in 7th SD 


CEL2 
Generalized 


B=l -k^ 
(single 
precision) 


E(m); k=J m 
E(a); k = sin a 


m= .01(01) 
a = 1(1)86 


2 in 7th SD 
2 in 7th SD 


complete 




K'E + E'K - KK" 


m= .01(.01).99 


7 in 7th SD 


elliptic 




(Legendre's re- 


a = 1(1) 89 


1 in 6th SD 


2nd 
integral 




lation) 






K(k) 


K(m); k = y m 


m= .01(.01).99 


2 in 16th SD 




with A = B = 1 










E(k) 


K(a); k = sin a 


a = 1(1)80 


2 in 16th SD 




with A = 1 


(a in degrees) 








B= 1 -k2 




a = 81(1)86 


11 in 16th SD 




(double 


E(a); k= sin a 


a = 1(1)89 


2 in 16th SD 




precision) 


K'E + E'K - KK' 


m= .01(.01).99 


9 in 16th SD 






(Legendre's 


a = 1(1)89 


9 in 16th SD 






relation) 








F(C/a) 


F(C/a) 


Z = 0(5)10 


2 in 7th DP 




with 


(^, a in degrees) 


a = 0(2)90 






X = tan ^ 










k = sinrv 










ck =il l-k2 












Z = 15(5)35 


7 in 7th SD 




(single 




a = 0(2)90 






precision) 




Z = 40(5)50 
a = 0(2)90 


11 in 7th DP 


ELIl 






Z = 55(5)85 


3 in 7th SD 


Incomplete 
elliptic 1st 
integral 






0! = 0(2)90 




F(<p/a) 


F((p/a) 


(p = 0(5)85 


1 in 9th DP (prob- 


with 


(<jc , a in degrees) 


0! = 0(2)90 


ably due to rounding 




X = tan <p 






errors in table) 




k = sin a 










ck =J 1 - k^ 


F(<p/a) + F{4>/a). 


cp = 0(5)85 






/ _ \ 




2 in 15th DP 




(double 


= .(!/„) 


a = 0(2)80 






precision) 










<fP, a, $ in degrees) 


i^ = arctan f 

f = l/(cos a 'tan 0) 
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Functions 




Range 






Functions 








Maximum 


Name 


calculated 


checked 

with reference 




checked 

with reference 


difference 




F(C/a) 


F(C/a) 


c 


= 0(5)10 


2 in 7th DP 




with A = B = 1 


(^ , a in degrees) 


a 


= 0(2)90 






E(C/a) 




C 


= 15(5)35 


7 in 7th SD 




with A = 1 




a 


= 0(2)90 






and B = 1 - k^ 












X = tan^ 




C 


= 40(5)50 


11 in 7th DP 




k = sina 




a 


= 0(2)90 






ck =Jl -k2 




a 


= 55(5)85 
= 0(2)90 


3 in 7th SD 




(single 












precision) 


E(C/a) 


C 


= 0,5 


2 in 7th DP 






(g , a in degrees) 


a 


= 0(2)90 










C 


= 10(5)35 


7 in 7th SD 








a 


= 0(2)90 










C 


= 40(5)55 


12 in 7th DP 








a 


= 0(2)90 




ELI2 






I 


= 60(5)85 


36 in 7th DP 


Generalized 






a 


= 0(2)90 




incomplete 




" "~~ "~ *"■ "~~ "" ~~ 


"~~ "*" 


— — «. 




elliptic 


F{9/a) 


F{(p/a) 


<?> 


= 0(5)85 


1 in 9th DP (prob- 


2nd integral 


with A = B = 1 
E{(p/a) 

with A = 1 


{<fi , a in degrees) 


a 


= 0(2)90 


ably due to rounding 
errors in table) 




B = l-k2 


E(<p/a) 


<P 


= 0(5)85 


1 in 9th DP 




and 


(<10 , a in degrees) 


a 


= 0(2)90 


(probably due to 




X = tan (p 








rounding errors in 




k = sina 








table) 




ck =J l-k2 


E{(p/a) +E(il>/a) 


(P 


= 0(5)85 


2 in 15th DP 




(double 
precision) 


^^ ' sin^ 


a 


= 0(2)90 








(<p , a in degrees) 


4> 
f 


- arctan f 

= l/(cos a • tan 0) 








F(<p/a) + F(i^/a) 


<P 


= 0(5)85 


3 in 15th DP 






= Ki^") 


a 


= 0(2)82 








(fP , a in degrees) 


f 


= arctan f 

= l/(cos a. • tan (p) 
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Name 



JELF 
Jacobian 
elliptic 
functions 



Functions 
calculated 



sn u = sin <p 
en u = cos (p 

dnu=yi-k2sinV 

with 

(p = am u or 

u = F{(p/a), 

k = sin a 

sck = l-k2 

(single 
precision) 



Functions 
checked 

with reference 



sn u = sin (p 

{<p ,a ia degrees) 

en u = cos <p 

((p , a in degrees) 

dnu =^ll-k^sia^(p 
{<P , a in degrees) 



sn u 

en u 

dnu 

sn u - sn(2K-u) 

sn u + sn(2K + u) 

sn u + sn(4K - u) 

en u + cn(2K - u) 

en u + cn(2K + u) 

en u - cn(4K - u) 

dn u - dn(2K - u) 
dn u - dn(2K + u) 

dn u - dn(4K - u) 



Range 

checked 

with reference 



= 0(1)89 

= 0(5)85 

= 0(1)89 

= 0(5)85 

= 0(1)89 

= 0(5)85 



k2 = .00(.05).95 
t = 0(1)25 
u = t.K(k)/25 

k2 = .00(.05).95 
t = 0(1)25 
u = t.K(k)/25 

k^ = ,00(.05).95 
t = 0(1)25 
u = t.K(k)/25 

k2 = . 00(. 05) . 90 
t = 0(1)25 
u = t.K(k)/25 



k2 = .00(. 05).90 
t = 0(1)25 
u = t.K(k)/25 



k^ = .00(.05).90 
t = 0(1)25 
u = t.K(k)/25 



Maximum 
difference 



1 in 6th DP + 

2 in 6th DP ■*" 

1 in 6th DP + 

1 in 6th DP ++ 

2 in 6th DP ++ 
1 in 6th DP ++ 



6 in 6th DP 
6 in 6th DP 



10 in 6th DP 
4 in 6th DP 

4 in 6th DP 

6 in 6th DP 

3 in 6th DP 
3 in 6th DP 

5 in 6th DP 



+ Calculation of u = F(fp/a) with double-precision subroutine 
++ Difference between result of single- and double-precision routines 
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Name 


Functions 
calculated 


Functions 

checked 

with reference 


Range 

checked 

with reference 


Maximum 
difference 




sn u = sin cp 


sn u = sin <p 

{(p, a in degrees) 


(p = 5(5)85 
a = 0(2)90 


2 in 15th DP ■*" 


Jacob ian 


en u = cos cp 


en u = cos (p 


cp = 5(5)85 


3 in 15th DP + 


elliptic 




((p , a in degrees) 


a = 0(2)90 




dnu=Vl-k2o! 

2 
(a = sin <p) 


functions 




(p = 5(5)85 


2 in 15th DP + 


dn u =V l-k2sin2<p 




with 


{(p, a in degrees) 


a = 0(2)90 






<p = am u 










u = F{<p/a) 


sn u - sn(2K - u) 


k2 = .00(.05).90 


5 in 15th DP 




k = sin a 




t = 0(1)25 






sck = 1 - k2 










(double 


sn u + sn(2K + u) 


u =t.K(k)/25 


5 in 15th DP 




precision) 


sn u + sn(4K - u) 




12 in 15th DP 






en u + cn(2K - u) 


k2 = .00(.05).90 
t = 0(1)25 


3 in 15th DP 






en u + cn(2K + u) 


u = t. K(k)/25 


3 in 15th DP 






en u - cn(4K - u) 




7 in 15th DP 






dn u - dn(2K - u) 


k^ = ,00(.05).90 
t = 0(1)25 


3 in 15th DP 






dn u - dn(2K + u) 


u = t.K(k)/25 


2 in 15th DP 






dn u - dn(4K - u) 




6 in 15th DP 


LGAM 


Inr(x) 


In r (x) 


x=l 


6 in 9th DP 


aogof 






x=1.005(,005) 




the gamma 






1.025 


9 in 8th DP 


function) 






xr=1.980(.005) 

1.995 
x=1.03(.01)1.31 
x=1.32(.01)1.67 
x=1.68(.01)1.97 
x=2 


9 in Stii SD 
8 in 9th SD 
8 in 10th SD 
7 in 9th SD 
6 in 9th SD 






iog,,r(x) 


x=3. 0(1. 0)100.0 


No error in 8 place 








tables 


NDTR 


y = P (X) 
P = normal 
pdf 


y = P (X) 


X = -6 (. 01)6 


7 in 7th DP 


NDTI 


X = P-1 (y) 

p = normal 

pdf 


X = P'V) 


y=. 01 (.01). 99 


5 in 4th DP 
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Name 



SMm 

Kolmogorov- 
Smirnov 
limiting 
distribution 



Functions 
calculated 



L(x) 



Functions 

checked 

with reference 



L(x); 
Tables by 
N. Srairnov, 
reprinted in 
Annals of Math. 
Stat. 19, pp. 
280-281 (6- and 
7- place 
tables). 
Double-preci- 
sion version 
differences 
are given in 
parentheses in 
the right-hand 
column. 



Range 
checked 
with reference 



x = 0(.01) .61 
x = .62 

x = . 63 (.01) 1.04 

x = 1.05(.01)1.15 

x-1.16(.01)1.20 

x = 1.21 (.01) 1.45 

x = 1.46(.01)1.65 

x=1.66(.01)1.86 

x=1.87 

x= 1.88 (.01) 2. 04 

X = 2. 05 (. 01) 2. 50 

x=2. 51(. 01)3. 5 



Maximum 
difference 



1 in 6^ DP 

(1 in 6th DP) 

3 in 5th dp 
(see program 
comments) 
(3 in S^^BT?) 

3 in 6th DP 
(2 in 6th DP) 

6 in 6th DP 
(2 in 6th DP) 

9 in 6th DP 
(2 in 6th DP) 

8 in 6th DP 
(3 in 6th DP) 

6 in 6th DP 
(1 in 6th DP) 

2 in 6th DP 

(0 in 6th DP) 

2 in 5th DP 
(2 in 5th DP) 

2 in 6th DP 
(1 in 6th DP) 

1 in 6th DP 

(1 in 6th DP) 

2 in 7th DP 

(1 in 7th DP) 
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APPENDIX B: SAMPLE PROGRAM DESCRIPTIONS 



The following programs are intended to exemplify 
linkage of subroutines within SSP/PL/l. These 
programs are only examples and are not meant 
to be representative of the state of the art. 

When supplying data for the sample programs, 
the user is reminded that all fixed point numbers 
must be right -adjusted and that all floating point 
numbers may appear anywhere in the field, pro- 
vided the decimal point is included. 

The necessary job control and process cards 
are included in the sample programs but are not 
separately shown in the deck setup illustrations. 

Note that arrays are limited, for each dimension, 
to an upper boimd of 32,767. 

DATA SCREENING DACR 

Problem Description 

A set of observations is read along with information 
on propositions to be satisfied and limits on a 
selected variable. From this input a subset is ob- 
tained and a histogram of frequency over given class 
intervals Is plotted for the selected variable. Total, 
average, standard deviation, minimum, and maxi- 
mum are calculated for the selected variable. This 
procedure is repeated until all sets of input data 
have been processed. 

Program 

Description 

The data screening sample program consists of a 
main routine, DACR, a special iaput routine DATl, 
and three subroutines from the Scientific Subroutine 
Package: SBST, TABl, and BOOL. There is also 
one special plotting routine, HIST. For a descrip- 
tion of subroutine BOOL see subroutine SBST. 

Capacity 

1. Up to 4999 observations 

2. Up to 70 variables 

3. Up to 99 conditions (with the existing sub- 
routine BOOL only two conditions are considered). 

4. Up to 10 data cards per observation 

Input 

Control Cards 

A parameter card with the following format must 
precede each matrix of observations. 



Columns 


Contents 


For Sample 
Problem 


1-6 


Problem number 

(maybe 

alphameric) 


SAMPLE 


7-11 


Number of 
observations 


0100 


12-16 


Number of 
variables 


0004 


17-21 


Number of 
conditions 


02 


22-26 


Number of 
selections 


00003 


27-31 


Number of data 
cards per 






observation 


01 


Data Cards 







1. For the observation matrix, data cards have 
seven fields of ten columns each. The decimal point 
may appear anywhere in a field. If no decimal point 
is included, it is assumed that the decimal point is 
to the right of the last digit. The number in each 
field may be preceded by blanks. All values for an 
observation are punched consecutively and may con- 
tinue from card to card. However, a new observa- 
tion must start in the first field of a new card. 

2. For the condition matrix three ten-column 
fields are used. The first contains the variable 
number (right- justified); the next, the relations 
code; and the last, a floating point number that re- 
lates to the condition. 

Selection Card 

For each selection there will be a new selection 
card. The card is prepared as follows: 

For Sample 
Problem 



Columns 



Contents 



1-5 



00003 



Number of the 
variable to be 
tabulated 
Lower bound 
Number of intervals* 
Upper boimd 

The number of selection cards must agree with 
the value of the selection indicator, which appears 
in columns 22-26 of the control card. 



6-15 
16-25 
26-35 



120. 

20. 

210. 



*]h the number of Intervals, it should be noted that 
two extra intervals must be specified for those ele- 
ments that fall below the lower bound and those that 
fall above the upper bound. 
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Deck Setup 

The deck setup is shown in Figure 11. 




Last problem 



Second problem 



First problem 



Procedures and main program 



Figure 11. 



Sample 



A listing of input cards for the sample problem is 
shown in Figure 12. 



46. 


64. 


173, 


12. 


24. 


12. 


17C. 


a. 


32. 


71. 


154. 


16. 


4X. 


68. 


129. 


10. 


50. 


65. 


192, 


9. 


63. 


15. 


203. 


12. 


29. 


70. 


122. 


14. 


28. 


64. 


136. 


13, 


52. 


77, 


147. 


11. 


36. 


67. 


153, 


16. 


31. 


68, 


165. 


9, 


72. 


K, 


176. 


10, 


53. 


Jl. 


2C5. 


14. 


21. 


65. 


219, 


12. 


49. 


63. 


150, 


6. 


28. 


62. 


16C. 


16. 


53, 


12. 


161. 


13. 


47. 


13, 


142. 


15. 


37. 


67. 


193. 


18. 


64. 


68. 


156. 


14. 


65. 


6C. 


114. 


10. 


62, 


64. 


153. 


12. 


19. 


68, 


225. 


9. 


46, 


67. 


15E. 


11. 


33. 


72. 


121. 


4. 


37. 


65. 


132. 


13. 


41. 


16. 


148. 


16. 


52. 


71. 


123. 


16. 


29. 


66, 


128. 


14. 


32. 


65. 


155. 


17, 


24. 


72, 


172. 


16. 


56. 


73, 


163. 


10. 


63. 


65. 


156, 


11. 


67. 


69. 


146. 


2. 


58. 


66, 


171. 


9. 


41. 


65. 


153, 


12. 


49. 


66. 


165. 


14, 


52, 


12. 


172. 


16. 


23. 


78. 


183. 


15. 


56. 


71. 


195. 


16. 


52. 


66, 


116. 


7, 


4C. 


66. 


165. 


14. 


39. 


68. 


215. 


16. 


23. 


71. 


154. 


12, 


56. 


65. 


14S. 


10. 


25. 


65. 


162. 


16. 


37. 


68. 


152. 


16. 


46. 


7C, 


15?. 


15. 


41. 


69. 


137. 


14. 


62. 


71. 


163. 


12. 


29, 


72, 


191, 


4. 


19. 


66. 


166. 


10. 


46. 


63, 


158. 


16. 


37, 


64. 


135. 


18. 


34. 


68. 


156. 


10. 


64. 


67. 


153. 


12. 


57. 


67. 


141. 


13. 


32. 


68. 


157. 


17. 


29. 


7C. 


183. 


15. 


53, 


72, 


164. 


18. 


47. 


72. 


156. 


16. 


56. 


73. 


16C. 


16. 


61. 


74. 


169. 


12. 


21. 


66. 


161. 


10. 


25. 


76. 


176. 


11. 


23. 


72. 


157, 


16. 


29. 


66. 


186. 


16. 


39. 


7C. 


15S. 


14. 


42, 


7C. 


154. 


IC. 


56. 


62. 


15S. 


12, 


63. 


7C. 


177, 


12. 


51. 


11. 


161. 


9. 


41. 


66. 


156. 


10. 


33. 


6?. 


156. 


16. 


37. 


68. 


157. 


16. 


25. 


K. 


163. 


15. 


63. 


68. 


159. 


12. 


53. 


71. 


202. 


6. 


51. 


72. 


167. 


14, 


47. 


73. 


164. 


14. 


39. 


15, 


151. 


12. 


26. 


66. 


166. 


10. 


64, 


69. 


156. 


16. 


55. 


67. 


\^k. 


16. 


51. 


66. 


177, 


10. 


46. 


65. 


157. 


1?, 


72, 


66. 


125. 


10. 


66. 


65. 


131. 


12, 


28. 


74. 


149. 


16. 


27. 


H. 


168. 


11. 


23. 


72, 


156. 


12. 


23. 


72. 


163. 


12. 


6C. 


66. 


157. 


9. 


3C, 


66. 


142, 


10. 


39. 


67. 


162. 


16. 


46. 


74. 


154. 


16. 


5C. 


68. 


156. 


10. 


61. 


66. 


161. 


14. 


36. 


64. 


157. 


15. 


32. 


71. 


156. 


16. 





1 


2 


65 




4 


6 


6 


3 


12C. 


2C. 


210. 


1 


2C. 


7. 


7C. 


4 


IC. 


12. 


2C. 



Figure 12, 



Output 



Description 



100 
110 
120 
130 
140 
150 
160 
170 
180 
190 
200 
210 
220 
230 
240 
250 
260 
2 70 
230 
290 
300 
310 
320 
330 
340 
350 
360 
370 
380 
390 
400 
410 
420 
430 
440 
450 
460 
470 
480 
490 
500 
510 
520 
530 
540 
550 
560 
570 
580 
590 
600 
610 
620 
6 30 
640 
650' 
660 
670 
680 
690 
700 
710 
720 
730 
740 
750 
760 
770 
780 
790 
800 
810 
820 
830 
840 
850 
860 
870 
380 
890 
900 
910 
920 
930 
940 
950 
960 
970 
980 
990 
1000 
1010 
1020 
1030 
1040 
1050 
1060 



The output consists of the subset vector whose 
element values indicate which corresponding observa- 
tions are rejected (element = zero) and accepted 
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(element \= nonzero), summary statistics for each 
selected variable, and a histogram of frequencies 
versus intervals for that variable. 



Sample 

The output listing for the sample problem is shown ui 
Figure 13. 



CilTA SCREENING PRCBLEf* SAMPLE 












SLBSET 
1 


VECTCB 
l.C 51 


C.C 












2 


C.C 52 


l.C 












3 


l.C 53 


l.C 












A 


l.C 54 


l.C 












5 


l.C 55 


l.C 












6 


l.C 5t 


l.C 












7 


l.C 57 


l.C 












e 


l.C 58 


l.C 












9 


l.C 5S 


l.C 












ic 


l.C 6C 


l.C 












u 

12 


l.C 61 

C.C 62 


l.C 

l.C 












13 


l.C 63 


l.C 












11 


l.C t4 


l.C 












15 


O.C 65 


l.C 












It 


l.C 66 


l.C 












17 


l.C 67 


l.C 












18 


l.C 68 


l.C 












IS 


l.C 6S 


l.C 












2C 


l.C 7C 


l.C 












21 


l.C 71 


l.C 












22 


l.C 72 


l.C 












23 


l.C 73 


1.0 












2A 


l.C 74 


l.C 












25 


C.C 75 


l.C 












26 


l.C 76 


l.C 












27 


l.C 77 


l.C 












28 


l.C 76 


C.C 












2S 


l.C 79 


l.C 












3C 


l.C ec 


l.C 












31 


l.C 81 


l.C 












32 


l.C 82 


l.C 












33 


l.C 83 


l.C 












3A 


O.C 84 


l.C 












35 


l.C 85 


l.C 












3* 


l.C E6 


l.C 












37 


l.C 87 


CO 












38 


l.C ee 


C.C 












3"; 


l.C 89 


l.O 












4C 


l.C 9C 


l.C 












-il 


C.C 91 


l.C 












«2 


l.C 92 


l.C 












*3 


l.C 93 


l.C 












44 


l.C 94 


l.C 












A5 


l.C 95 


l.C 












4t 


l.C 96 


l.C 












47 


l.C 97 


l.C 












48 


l.C 98 


l.C 












4S 


l.C 99 


l.C 












5C 


l.C ICC 


l.C 












SUMMARY 


STATISTICS 


FOR VARIABLE 3 












TOTAL =1 


4492.000 AVERAGE = 161.022 


STANDARD DEVIATION 


= 


19.329 MINIMUM 


= 


114. OCO MAXIMUM = 225.000 








HISTOGRAM 


I 








fREflUENCV 1 2 


2 1 3 


4 4 10 23 


14 


8 4 3 


2 


12 1113 


23 
















22 
















21 
















20 
















19 
















18 
















17 
















16 
















15 
















14 
















13 
















12 
















11 
















10 
















9 
















8 
















7 
















6 
















5 
















4 






• • * ♦ 




* * 






3 




* 


* * * * 




• • * 




• 


2 


* 


* * 


« * * * 




» * * 


* 


* « 


1 


* * 


• * * 


« • » « 




* « * 


* 




INTERVAL 


1 2 


3 4 5 


6 7 6 9 


10 


11 12 13 


14 


15 16 17 18 19 20 


CLASS 

















Figure 13. 
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SLP-'iSY STATISTICS fCD VARUELE 1 

TCTAL = 3eC4.C0C AVERAGE = A2.267 STAKDARO CEVIATION 

t-lSTCGRA*- 2 



13.*67 MINIMUM 



IKTERVAL 
CLASS 



SUMMARY STATISTICS FCR VARIABLE 4 

TCTAL = 1205. OOC AVERAGE = 13.38S STANDARD DEVIATION = 



2.685 MINIMUM ■■ 



9,000 MAXIMUM - 



END OF CASE 



ENC OF SAMPLE PROGRAM 



Figure 13. (Continued) 



Program Modifications 

1. Changes in the input format statement of the 
special input routine, DATl: 

Only the format statement for input data may 
be changed. Since sample data are either two- or 
three-digit numbers, rather than using ten-column 
fields, as in the sample problem, each row of data 
might have been keypunched in three -column fields; 
if so, the format is changed to (7F(3, 0)). This 
format assumes seven 3-column fields per card, 

2. K tiiere are more than seven variables in a 
problem, each row of data is continued on the second 
card until the last data point is keypunched. How- 
ever, each row must begin on a new card. If there 

is more than one data card per observation, the value 
of the data card count indicator (NCARD) , which 



appears in columns 27-31 of the control card, must be 
changed to agree with the number of data cards. 

3. Subroutine BOOL can be replaced if the user 
wishes to use a different boolean expression (see 
description in subroutine SBST). The boolean ex- 
pression provided in the sample program is for both 
conditions to be satisfied: 

T = R(l) * R(2) 

Operatiag Instructions 

The sample program for data screening is a standard 
PL/I program. Special operating instructions are not 
required. Data set SYSIN is used for input; data set 
SYSPRINT is used for output. 
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Timing 

The execution time of this sample program on 
System/360 Model 40, using an IBM 2540 Card 
Reader as input and an IBM 1403, Model Nl, as 
output, is 40 seconds. 



END,. 
END.. 
END,. 

PUT EDIT CENO OF CASE') ( SK1P(2 ) , COLUHN( 10 > , A) , . 
END.. 

GO TO STRT,. 
EXIT.. 

PUT FILE (SVSPRINT) EDIT I'END OF SAMPLE PROGRAM* ) 
(SKIP(5).CDLUMN(X0) .A I.. 
FIN.. 

END,. /«£ND OF PROCEDURE OACR 



0ACR1050 
OACR 1060 
DACR1070 
DACR1080 
DACR1090 
OACR 1100 
DACRlllO 
DACR1120 
DACR1130 
DACRIKO 
*/DACRll50 



tt^**************************** 



OACR 

«****«»»*****«*««********/DACR 

«/DACR 

/* TO PERFORM DATA SCREENING CALCULATIONS ON A SET OF" */DACR 

/* OBSERVATIONS. */DACR 

/# */DACR 

/**«***»*»»**«***»**»»*«*******»»***»**»***»******************»******«/DACR 



PROCEDURE OPTIONS (MAIN).. 
DECLARE 

(N0,NS,NN.NNN.NC,1»J,N0VAR,NX,NC0L,L1,L2) 

FIXED BINARY. 

PRl CHARACTER 161, 

ERROR EXTERNAL CHARACTERt I ) , 

CH CHARACTER (80) . 

(NV.NCARO) EXTERNAL. 

BOOL ENTRY,, 
/* 

ON ENDFILE (SYSINl GO TO EXIT,. 
STRT,, 

GET EDIT (CH) (A(80)).. 

GET STRING (CH) EDIT (PRl .NO.NX.NCNS.NCARD) 1AI61,5 F(5)) 



/* 



PRl PROBLEM NUMBER (MAY BE ALPHAMERIC) 

NO NUMBER OF OBSERVATIONS 

NX NUMBER OF VARIABLES 

NC NUMBER OF CONDITIONS- 

NS NUMBER OF SELECTIONS 

NCARD NUMBER OF DATA CARDS PER OBSERVATION 

NCARD=NCARD*80.. 
E.. 
BEGIN,. 
DECLARE 

IA(NO,NX),C13.NC)tUBO{3).SlNO).R(NC),STATS(5),0(NX),OD(3)l 

FLOAT BINARY,, 

IF INPUT DATA IS TO BE SAVED ON A DATA SET 
NV=1. OTHERWISE NV=0. 



/* READ IN DATA 



/• READ IN CONDITIONS 



NV =0.. 

DO I = 1 TO NO,. 
CALL DATI(NX,D>,, 

00 J > 1 TO NX*. 
A(I*J)=D(J).. 
END,. 
END,. 
NCARO=80,. 

DO I = 1 TO NC 
NNN =3,. 

CALL DATl (NNN, DO),. 
DO J = I TO 3,. 
C(J,I)=OD{J),. 
END,. 
END.. 
CALL SBST (A.C,R,BOOL,S.NO,NX,NC) 
PUT EDIT ('DATA SCREENING PROBLEM 
IF ERROR NE 'O* 
THEN DO,. 

PUT EDIT (MN ROUTINE SBST ERROR CODE = 

{SKIPI2),C0LUMN(10),A,A(1)),. 
GO TO FIN,. 
END,. 
PUT EDIT ('SUBSET VECTOR*) (SKIPO) .CQLUMN( lOl.A.SK IP( 3) ) , . 
NCOL =CEILINO/50),. 
IF NCOL LE I 

THEN PUT EDIT ((I,S(I) DO 1= 1 TO NO)) (COLUMN (10) .F(6) ,F( 5, 1 ) ) 
ELSE DO.. 



LI 



=0, 



NN 



= I TO 50.. 

LI =L1+1,. 

L2 =50*INCOL-1)+L1,. 

IF L2= NO 

THEN NCOL =NCOL-l.. 

PUT EDIT <(J,S(J) 00 J= 

.(9)(F(6),F(S,1))),. 

END,. 
END,. 

DO J = 1 TO NS,. 
GET EDIT (CH) (A(80)),. 
GET STRING (CH) EDIT INOVAR, (UBa( I } DO 1= L TO 3) 

IF(5).3 FllO.O)).. 

NOVAR NUMBER OF THE VARIABLE TO BE TABULATED 

UBOIl) LOWER BOUND 

UBa(2)... .NUMBER OF INTERVALS 
UB0(3)... .UPPER BOUND 

=UB0(2).. 



DACR 

DACR 90 

DACR 100 

DACR 110 

DACR 120 

OACR 130 

DACR 140 

DACR 150 

OACR 160 

♦/DACR 170 

DACR 180 

DACR 190 

OACR 200 

DACR 210 

*/OACR 220 

*/DACR 230 

*/DACR 2-^0 

♦/DACR 250 

♦/DACR 260 

♦/DACR 270 

♦/DACR 280 

♦/DACR 290 

OACR 300 

OACR 310 

DACR 320 

OACR 330 

DACR 340 

DACR 350 

♦/DACR 360 

INITIALIZE ♦/DACR 370 

♦/OACR 380 

♦/DACR 390 

DACR 400 

♦/OACR 410 

OACR 420 

OACR 430 

DACR 440 

DACR 450 

OACR 460 

DACR 470 

•/OACR 480 

OACR 490 

OACR 500 

DACR 510 

OACR 520 

DACR 530 

OACR 540 

DACR 550 

PRl) {PAGE,COLUHN< 10) , A,X(4) . A) , .OACR 560 

DACR 570 

DACR 580 

OACR 590 

DACR 600 

OACR 610 

DACR 620 

DACR 630 

DACR 640 

OACR 650 

OACR 660 

DACR 670 

OACR 680 

DACR 690 

DACR 700 

DACR 710 

DACR 720 

DACR 730 

LI TO L2 BY 50)) (SKIP,COLllMN( 10 ) OACR 740 

DACR 750 



.ERROR) 



BEGIN.. 

DECLARE 

(FREQ(NN),PCT(NN)) FLOAT BINARY.. 
CALL TAB! ( A, S.NOVAR.UBO.FREQ.PCT, STATS.NO.NX 1 . . 
IF ERROR NE 'O' 
THEN PUT EDIT ('IN ROUTINE TABl ERROR CODE = '.ERROR) 

(SK1P{1).C0LUMN(10>.A.A(1)),. 
ELSE DO,. 

PUT EDIT ('SUMMARY STATISTICS FOR VARIABLE •, NOVAR) 
(PAG£.SKIP(4).COLUHN(10).A.F(3>>,. 

PUT EDIT ('TOTAL =• .STATS t 1) .* AVERAGE =',STATS(2) 
•STANDARD DEVIATION =• ,STATS (3) , 'MINIMUM ='. 
•MAXIMUM ='',STATS(5») 

(SKIP(2),COLUMN(10),5(A,F(9.3I.X(2)))t. 
CALL HIST {J,FREQ,NN).. 



DACR 760 

DACR 770 

OACR 780 

OACR 790 

DACR 800 

OACR 610 

♦/DACR 820 

*/DACR 830 

♦/DACR 840 

*/DACR 850 

♦/DACR 860 

♦/DACR 870 

DACR 860 

OACR 890 

OACR 900 

DACR 910 

DACR 920 

DACR 930 

DACR 940 

DACR 950 

DACR 960 

DACR 970 

DACR 980 

DACR 990 

, DACRIOOO 

STATS14),DACR10IO 

nACR1020 

OflCR1030 

DACR1040 



*♦»«*«*•*♦»« 



»*«»*»*»**«*#*#?*»*♦♦♦«♦, 



TO PERFCRM A EOGLEAN CPERATICN FCR THE PROCEDURE SBST, WHICH * 
IS USED BY THE DATA SCREENING SAMPLE PRCGRAM. 

#*«***»*«»«#•*»•**♦**«*•••»***•*•***•** ****»*«**»**»*»**********^ 
PROCEDURE (R.T),. 
DECLARE (R(*),7) FLCAT BINARY.. 

BOOL CHECKS ONLY THE FIRST THC CONOITICNS CF PROCEDURE SBST 
T =R(ll*R12),. 
RETLRN,. 
EfjD,. /♦END CF PROCEDURE 900L 



BOOL 10 

/BCCL 20 

/BOOL 30 

/BOCL 40 

/POOL 50 

/BOCL 60 

/BOCL 70 

POOL 80 

BOCL 9C 

/BOCL 100 

BOOL llO 

eOCL 12C 

7BO0L 130 



hIST.. HIST 

/♦ ♦/HIST 

/* TC PLOT A HISTOGRAM CF FREQUENCIES FCR THE DATA SCREENING */HIST 
/♦ SAMPLE PROGRAM. ♦/HIST 

/# •/HIST 

/*»*»♦♦ ♦♦♦♦♦♦•••♦•••••♦♦♦•••••♦••♦♦♦••♦♦♦♦♦••••••♦♦♦♦♦••••♦♦♦♦•♦♦♦•♦•*/H I ST 

PROCEDURE (NZ.FREQ.INI,. 
DECLARE 

II,IN,IX,J,JSCAL,L.MAX,NU,NZ) 

FIXED BINARY, 

(K.JOUTdN)) CHARACTER (1), 

IFREO(«),FMAX>X) FLOAT BINARY,. 



PRINT TITLE AND FREQUENCY VECTOR 

PUT EDIT ('HISTOGRAM ',NZ) ( SKIP (3) ,C0LUMM57) , A, Fl 3) > , 

NU =FL00R(100/IN),. 

PUT EDIT ('FREQUENCY', IFREQ(I) DO I = 1 TO IN)) 

(SKIP(2),C0LUMN( 10) ,A, ( IN) F(NU) 1 . . 
PUT EDIT (• 



FIND LARGEST FREQUENCY 



/• SCALE IF NECESSARY 



LOCATE FREQUENCIES IN EACH INTERVAL 

MAX =FL00R(FMAX/JSCAL1,. 
DO I = 1 TO MAX.. 
X =MAX-(I-1),. 

DO J = 1 TO IN,. 

IF FREQ( J)/JSCAL GE X 

THEN JOUT(J)='^',. 

END*. 
IX =X*JSCAL,. 

PRINT LINE OF FREQUENCIES 

PUT EDIT (IX,1JCUT(L) DC L = I TO IN)) ( SKIP, COLUMN ( 10 

XI 4) ,IIN)tX(NU-l>,A(l) )) ,. 
END,. 

CO I = 1 TO IN,. /* GENERATE CONSTANTS 
FREQ(I)=I,. 
END.. 
PUT EDIT (• 



HIST 80 

HIST 90 

HIST 100 

HIST 110 

HIST 120 

HIST 130 

•/HIST 140 

♦/HIST 150 

♦/HIST 160 

HIST 170 

HIST 180 

HIST 190 

HIST 200 

HIST 210 

HIST 220 

HIST 230 

HIST 240 

HIST 250 

•/HIST 260 

HIST 270 

HIST 280 

HIST 290 

HIST 300 

•/HIST 310 

HIST 320 

HIST 330 

HIST 340 

HIST 350 

HIST 360 

HIST 370 



(R(FMl)).. 
FMl.. 

FORMAT (SKIP.C0LUMNU2).A,A) 
FMAX =0,, 

DO I = 1 TO IN,. 
IF FREQ(I) GT FMAX 
THEN FMAX =FREQtI ),. 
END,. 
JSCAL=1,. 
IF FMAX GT 50 
THEN DO,. 

J SCAL=FLOOR I ( FHAX+491 /50 ) , . 

PUT EDIT I'EACH','^',' EQUAL •,JSCAL,' POINTS') 

(SKIP,CCLUMN(10),A,A(1),A,F(2),A,SKIP),. 
END,. 

JOUT =' ',. /♦ CLEAR CUTPUT AREA TO BLANKS •/HIST 380 

/» •/HIST 390 

•/HIST 400 

•/HIST 410 

HIST 420 

HIST 430 

HIST 440 

HIST 450 

HIST 460 

HIST 470 

HIST 480 

HIST 490 

•/HIST 500 

•/HIST 510 

♦/HIST 520 

,F(5), HIST 530 

HIST 540 

HIST 550 

•/HIST 560 

HIST 570 

HIST 580 

— ', HIST 590 

•) HIST 600 

HIST 610 
HIST 62C 
HIST 630 
HIST 640 
HIST 650 
•/HIST 66C 



(R(FMl)),. 

PUT EDIT ('INTERVAL '.(FRECd) DG I = 1 TC IN)) 

(SKIP12),CCLUMN(1C),A,{IN)F(NU)).. 
PUT EDIT ('CLASS') I SKIP, COLUMN 1 10) , A) , . 
RETURN,, 
END,. /♦END CF PROCEDURE I 



DATl.. OATl 


10 


/***«*«****«*******«**^^^^^**4**«*^****^^^^*^*^^^^**^^^^^*^*^*^^^**«^^/DATl 




/» •/DATl 


30 


/• TO READ FLCATIRG PCINT DATA, ONE OBSERVATION AT A TIME. •/DATl 


40 


/♦ DATA MAY BE SAVED ON A DATA SET. */DATl 


50 


/* */DATl 


60 


/0»*********f*********************************»*************»*********/DAll 


70 


PROCEDURE (M,D),. 0*^1 


80 


DECLARE OATl 


9C 


XDATA FILE STREAM" ENVIRONMENT (CONSECUTIVE V12000,200) ) , DATl 


100 


(NCARD, NV) EXTERNAL, OATl 


110 


CH CHARACTER(hCARC) , DATl 


120 


(I.M.HM) BINARY FIXED, DATl 


130 


D(^) FLOAT BINARY,. DATl 


I4C 


/* •/DATl 


150 


ON ENDFILE ISYSIN) DATl 


160 


GO TO EXIT,. OATl 


170 


GET EDIT tCH) (A(NCARO))., DATl 


180 


MM =CEIL(M/7).. DATl 


no 


GET STRING (CH) EDIT ((D(I) DC 1= I TC M)) DATl 


200 


{|MM>I(71F(10,0),X(10)} ),. DATl 


210 
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IF NV= 1 




DATI 220 


THEN PUT FILE (XDATA) EDIT ((DID 


DO 1= 1 TO fit ((f)Ft6,0l»,. 


OATl 230 


REVERT ENOFILE (SYSINI.. 






RETURN.. 






EXIT.. 






PUT FILE (SYSPRINT) EDIT I 'ERROR 


INSUFFICIENT 0*TA') 




ISKIPU),COLUMN110),A).. 




DATI 280 


STOP,. 




DATI 290 




/*ENO CF PROCEDURE OAT I 


*/DATl 300 



routines named DAT2 and IDTl, and four sub- 
routines from the Scientific Subroutine Package: 
CORR, ORDR, MINV, and MLTR, 

Capacity 



MULTIPLE LINEAR REGRESSION REGR 

Problem Description 

Multiple linear regression analysis is performed for 
a set of independent variables and a dependent vari- 
able. Selection of different sets of independent 
variables and designation of a dependent variable 
can be made as many times as desired. 

The sample problem for multiple linear regres- 
sion consists of 30 observations with six variables , 
as presented in Table 1. The first five variables 
are independent variables (predictors) , and the last 
is the dependent variable (criteria). All five inde- 
pendent variables are used to predict the dependent 
variable in the first analysis, and only the second, 
third, and fifth variables are used to predict the 
dependent variable in the second analysis. 



Table 1. 



Observation 



Sample Data for Multiple Linear Regression 

Variables 



1 


29 


289 


216 


85 


14 


1 


2 


30 


391 


244 


92 


16 


2 


3 


30 


424 


246 


90 


18 


2 


4 


30 


313 


239 


91 


10 





5 


35 


243 


275 


95 


30 


2 


6 


35 


365 


219 


95 


21 


2 


7 


43 


396 


267 


100 


39 


3 


8 


43 


356 


274 


79 


19 


2 


9 


44 


346 


255 


126 


56 


3 


10 


44 


156 


258 


95 


28 





11 


44 


278 


249 


110 


42 


4 


12 


44 


349 


252 


88 


21 


1 


13 


44 


141 


236 


129 


56 


1 


14 


44 


245 


236 


97 


24 


1 


15 


45 


297 


256 


111 


45 


3 


16 


45 


310 


262 


94 


20 


2 


17 


45 


151 


339 


96 


35 


3 


18 


45 


370 


357 


88 


15 


4 


19 


45 


379 


198 


147 


64 


4 


20 


45 


463 


206 


105 


31 


3 


21 


45 


316 


245 


132 


60 


4 


22 


45 


280 


225 


108 


36 


4 


23 


44 


395 


215 


101 


27 


1 


24 


49 


139 


220 


136 


59 





25 


49 


245 


205 


113 


37 


4 


26 


49 


373 


215 


88 


25 


1 


27 


51 


224 


215 


118 


54 


3 


28 


51 


677 


210 


116 


33 


4 


29 


51 


424 


210 


140 


59 


4 


30 


51 


150 


210 


105 


30 





Program 














Descriptio 


a 













1. Up to 99, 999 observations can be read if obser- 
vations are read into the computer one at a time by 
the special input subroutine named DAT2. If all data 
are to be stored in core before the calculation of 
correlation coefficients , the limitation on the number 
of observations depends on the size of core storage 
available for input data. 

2. Up to 96 variables can be handled. 

3. Up to 99 selections can be handled. 

4. Up to eight cards per observation can be read. 

5. (12 F (6, 0)) format for input data cards. 
Therefore, if a problem satisfies the above conditions, 
the sample program need not be modified. If the 
input data cards are prepared using a different for- 
mat, the input format in the subroutine DAT2 must 

be modified. The general rules for program modi- 
fications are described later. 

6. Up to 40 Independent variables for one selec- 
tion can be read. 

Input 

Control Cards 

One control card is required for each problem and 
is read by the main program, REGR. This card is 
prepared as follows: 







For 


Columns 


Contents 


Sample 
Problem 


1-6 


Problem number (may be 
alphameric) 


SAMPLE 


7-11 


Number of observations 


00030 


12-13 


Number of variables 


06 


14-15 


Number of selections 
(see below) 


02 


16-17 


Number of data cards per 
observation 


01 



The multiple linear regression program consists of 
the main program named REGR, two special input 



Leading zeros do not have to be keypunched. 

Data Cards 

Since input data is read into the computer one obser- 
vation at a time , each row of data in Table 1 Is key- 
punched on a separate card using the format (12 F 
(6, 0)). This format assumes twelve 6-column 
fields per card. 
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Selection Cards 

For each selection there nmst be at least two cards, 
as described below. If the niunber of selections 
specified is zero, the program will terminate. An 
error message is printed out. 

The first card is used to specify a single dependent 
variable in a multiple linear regression analysis. 
Any one variable in the set of original variables can 
be designated as a dependent variable, and any posi- 
tive nimiber of variables can be specified as inde- 
pendent variables. Selection of a single dependent 
variable and a set of independent variables can be 
performed over and over again using the same set of 
original variables. 

The first card is prepared as follows: 



For Sample Problem 
Selection 1 Selection 2 



Columns Contents 

1-2 Option code for table 01 

of residuals if 
table is not desired; 
1 if table is 
desired. 

3-4 Dependent variable 06 

designated for the 
forthcoming re- 
gression. 

5-6 Number of independ- 05 
ent variables in- 
cluded in the forth- 
coming regression 
(the subscript num- 
bers of individual 
variables are 
specified below). 

The second card is prepared as follows: 



01 



06 



03 



The input format of (40 F (2)) is used for the 
second card. 

Deck Setup 

Deck setup is shown in Figure 14. 



Colxmins 



Contents 



For Sample Problem 
Selection 1 Selection 2 




Last problem 



Second problem 



Procedures and main program 



1-2 



3-4 



5-6 



7-8 



9-10 



etc. 



1st independent 01 

variable included 

2nd independent 02 

variable included 

3rd independent 03 

variable included 

4th independent 04 

variable included 

5th independent 05 

variable included 



02 
03 
05 



Figure 14. 



Sample 



The listing of input cards for the sample problem is 
shown in Figure 15. 
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SaCPLECCCSCMO 










10 


29 


2£S 


216 


85 


14 




20 


3C 


3S1 


244 


92 


16 




30 


3C 


424 


246 


9C 


le 




4C 


3C 


313 


239 


91 


ic 




50 


35 


243 


275 


95 


3C 




60 


35 


3€5 


219 


95 


21 




70 


43 


3^6 


267 


ICC 


39 






43 


35fc 


274 


79 


19 




9C 


44 


34t 


255 


126 


56 




100 


44 


156 


256 


95 


28 




1 10 


44 


2?t 


249 


UC 


42 




12C 


44 


349 


252 


ee 


21 




130 


44 


141 


236 


129 


56 




140 


44 


245 


236 


97 


24 




15C 


45 


2^7 


256 


111 


45 




160 


45 


3IC 


262 


94 


2C 




I7C 


45 


151 


339 


96 


35 




130 


45 


37C 


357 


£8 


15 




190 


45 


379 


196 


147 


64 




200 


45 


4t3 


2C£ 


1C5 


31 




210 


45 


316 


245 


132 


6C 




220 


45 


2ec 


225 


IC8 


36 




23C 


44 


3«5 


215 


ICl 


27 




24C 


4S 


139 


22C 


13fc 


59 




250 


45 


245 


2C5 


113 


37 




26C 


4S 


373 


215 


ee 


25 




270 


51 


224 


215 


118 


54 




2 30 


51 


677 


210 


116 


33 




290 


51 


424 


21C 


14C 


5S 




300 


51 


15C 


21C 


1C5 


3C 




310 


C106C5 












320 


CIC2C3C4C5 










330 


CIC6C3 












34C 


C2C3C5 












350 



Figure 15. 



Output 

Description 

The output based on the selection card of the sample 
program for multiple linear regression includes: 

1. Means 

2. Standard deviations 

3. Correlation coefficients between independent 
variables and dependent variables 

4. Regression coefficients 

5. Standard errors of regression coefficients 



6. Computed T values 

7. Intercept 

8. Multiple correlation coefficients 

9. Standard error of estimate 

10. Beta coefficients 

11. Analysis of variance for the multiple regression 

12. Table of residuals (optional) 

Sample 

The output listing for the sample problem is shown in 
Figure 16. 



MULTIPie REGRESSION... 


.SAMPLE 














NUMBER OF OBSERVATIONS 


30 




NUMBER OF VARIABLES... 
















SELeCTION 1 






VARIABLE MEAN 


STANDARD 




CORRELATION 


REGRESSION 


STD. ERROR 


COMPUTED 


BETA 


NO. 


DEVIATION 




X VS Y 


COEFFICIENT 


OF REG.COEFF. T VALUE 


COEFF. 


1 43.13333 


6.52176 




0.28422 


0.01242 


0.03635 


0.34171 


0.05735 


2 316.16650 


114.42990 




0.42189 


0,00739 


0.001B6 


3.96545 


0.59826 


3 241.79999 


36.43074 




0.11900 


0.015C4 


0.00635 


2.36881 


0.38790 


4 10 5.66666 


17.85640 




0.37822 


0.00151 


0.03679 


0.04100 


0.01907 


5 34.13333 


15.97571 




0.39412 


C. 049 19 


0.04141 


1.18782 


0.55631 


DEPENDENT 
















6 2.26667 


1.41259 














INTERCEPT 


-6.C792e 












MULTIPLE CORRELATION 


0.73575 












STD. ERROR OF ESTIMATE 


I.C5162 












ANALYSIS OF 


VARIANCE FOR THE REGRESSION 








SOURCE OF VARIATION DEGREES SUM OF 


MEAN 


F 


VALUE 






OF 


FREEDOM SOUAPES 


SQUARES 






ATRRI9UTABLE TO REGRESSION 


5 


31.325G6 


6.26501 5 


66508 




DEVIATION FROM REGRESSION 


24 


26.54161 


1.10590 






TOTAL 




29 


57.86667 











Figure 16 
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MULTIPLE REGRESSION SAMPLE 



TABLE OF RESIDUALS 



y VALUE 
l.COOOO 
2.0C000 
2.C0C0C 
0.00000 
2,0C0C0 
2.C0000 
3.00000 
2.00000 
3.00000 
C.OOOCC 
4.00000 
1.00000 
1.00000 
l.COOOO 
3.00000 
2.C0O00 
3.00000 
4.C000O 
4.00000 
3.0C000 
4.00000 
4.00000 
I. 00000 

o.coooo 

4.00000 
1.00000 
3.00000 

4.00000 
4.00000 

0.00000 



ESTIMATE 

0.43091 

1,7767C 

2.14566 

0.82880 

1.90522 

1,52125 

3.46447 

2.25887 

3.80259 

1.02042 

2.49735 

2.0C066 

2.00735 

1.15308 

2.90446 

1.83532 

2.56004 

3.45229 

3.62661 

2.68068 

3.64885 

1.86542 

2.09863 

1.97217 

1.41253 

1.88027 

2.27646 

4.51080 

3.95 745 

0.45458 



RESIDUAL 

0.51909 

0.2233C 

-C. 14586 

-0,82880 

0.09478 

0.47875 

-0.46447 

-0.25887 

-0.80259 

-1.0204? 

1.50265 

-1.C0C66 

-1.C0735 

-0.153C8 

C.C9554 

0. 16468 

C. 43996 

C. 54771 

C. 37339 

0.31932 

0.35115 

2.13458 

-1.09863 

-1.97217 

2.58747 

-0.88027 

C. 72354 

-c.sioec 

0.04255 
-0.45458 



MULTIPLE REGRESSION SAMPLE 

NUMBER OF OBSERVATIONS... 30 
NUMBER OF VAPIABLES 6 



SELECTION 2 



316.16650 

241.79999 

34.13333 



STANDARD 

DEVIATION 

114.42990 

36.43074 

15,97571 



CORRELATION 
X VS V 
0.42189 
0.11900 
0.39412 



REGRESSION 
COEFFICIENT 

0.00744 
0.01497 
0.05363 



STD. ERROR 
OF REG.COEFF. 

0.00172 

0.00551 

0.01258 



COMPUTED 
T VALUE 
4,31763 
2.71693 
4.26262 



BETA 

COEFF. 
0.60233 
0.38618 
0.60648 



6 2.26667 1.41259 

INTERCEPT -5.53528 

MULTIPLE CORRELATION 0.73423 

STD. ERROR OF ESTIMATE 1.01282 

ANALYSIS OF VARIANCE FOR THE REGRESSION 
SOURCE OF VARIATION DEGREE 



ATRPIBUTABLE TO REGRESSION 
DEVIATION FROM REGRESSION 
TOTAL 



MULTIPLE REGRESSION SAMPLE 



SUM OF 

SQUARES 

31.19594 

26.67073 

57.86667 



MEAN 

SQUARES 

10.39865 

1.02580 



F VALUE 
10.13714 



V VALUE 
1.00000 
2 . 00000 
2.00000 

c.ococo 

2.CO000 
2.00000 
3.00000 
2.CO0C0 
3.0C0C0 
C.OCOOO 
4.CO0O0 
l.OCOOC 
l.OOOCO 
l.COOOO 
3,00000 
2.00000 
3.00000 
4.C0000 
4.C00C0 
3.00000 
4.C0000 
4.00000 
l.COOOO 

o.oooco 

4.00000 

1 . ccooo 

3.00000 
4.00000 
4.00000 
O.OOOCO 



END OF SAMPLE PROGRAM 



Y ESTIMATE 
C. 59869 
1.88363 
2,26619 
C.907C4 
1.99FI12 
1.58408 
3.49858 
2.23348 
3.85875 
0.98943 
2.51254 
1,95925 
2.04998 
1.1C726 
2.91951 
1.76539 
2.54052 
3.36591 
3.67961 
2.65435 
3.7C045 
1.84629 
2.06900 
1.95640 
1.34019 
1.79817 
2.24542 
4.41266 
3.92577 
0.33332 



RESIDUAL 

0.40131 

0.11637 

-0.26619 

-C. 90704 

C. 00188 

0.41592 

-0.49858 

-0,23348 

-0.85875 

-0.99943 

1.48746 

-0.95925 

-1.04998 

-0,10726 

0.08C49 

0.23461 

0.45946 

0.634C9 

0.32C39 

0.34565 

0.29955 

2.15371 

-1,06900 

-1,95640 

2.65981 

-0.79617 

0.75458 

-0.41268 

0,07423 

-C. 33332 



Figure 16. (Continued) 
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Program Modifications 

Input data in a different format can also be handled 
by providing a special format statement. 

1. Changes in the input format statement of the 
special input routine DAT2: 

Only the format statement for input data may be 
changed. Since sample data are either one-, two-, or 
three-digit numbers, rather than using six-column 
fields, as in the sample problem, each row of data 
might have been keypunched in six 3-colimin fields; 
tf so, the format is changed to (6 F (3, 0)). 

The special input subroutine, DAT2, is nor- 
mally written by the user to handle different formats 
for different problems. The user may modify this 
routine to perform listing of input data, transforma- 
tion of data, and so on. When doing so, attention 
should be paid to the format statement in DAT2 
(DAT2 230) which writes on the intermediate data 
set. The format in this statement must be the 
same as the format in statement REGR 1860. 

2. If there are more than twelve variables in a 
problem, each row of data is continued on the next 
cards, until the last data point is keypunched. How- 
ever, each row of data must begin on a new card. 

In the sample problem there is one data card 
per row, so liie value of the card count indicator 
(NCARD), which appears in columns 16 and 17 of the 
control card, is set to one. If there is more than 
one data card per row, the value of the card count 
indicator (NCARD) must agree with the number of 
data cards per row. 

3. Althougji the program will allow 96 variables, 
the maximimi number of independent variables that 
may be specified on one selection is 40. 

Error Messages 

The following error conditions wiU result in 
messages: 

1. The number of selections is not specified on 
the control card: NUMBER OF SELECTIONS NOT 
SPECIFIED. JOB TERMINATED. 

Operating Instructions 

The sample program for multiple linear regression 
is a standard PL/l program. Special operating 
instructions are not required. Data set SYSIN is 
used for input; data set SYSPRINT, for output. A 
scratch tape (data set XDATA) is used as inter- 
mediate storage. 

Timing 

The execution time of this sample program on a 
System/360 Model 40, using anIBM 2540 Card 



Reader as input and an IBM 1403, Model Nl, as 
output, is 40 seconds. 



REGR 

* TO READ THE PROBLEM PARAMETER CARD FOR A MULTIPLE REGRESSION, */REGR 

* READ SUBSET SELECTION CARDS, CALL THE PROCEDURES TO CALCULATE«/REGR 

♦ MEANS, STANDARD DEVIATIONS, SIMPLE AND MULTIPLE CORRELATION */REGR 

♦ COEFFICIENTS, REGRE SSION COEFFICIENTS, T-VALUES, BETA COEFF- ♦/REGR 

• ICIENTS, AND ANALYSIS OF VARIANCE FOR MULTIPLE REGRESSION, */REGR 

* AND PRINT THE RESULTS. 



PROCEDURE OPTIONS CMAIN), 
DECLARE 

{l,II,I0,J,K.L.M,MM,N,NDEP,NRESI,NS,Ll,L2) FIXED BINARY, 

XOATA FILE STREAM ENVIRONMENT (CONSECUTIVE VC2000,200I ) , 

INCARO.NV) EXTERNAL, 

ERROR EXTERNAL CHARACTER (1), 

CH CHARACTER ISO), 

PRI CHARACTER (6).. 



FORMAT (A(6).F(5).3 FI2)),. 
ON ENDFILE (SYSIN) GO TO EXIT,. 



INPUT DATA IS SAVED IF NV IS SET TO 



SIOO.. 

GET EDIT (CHI (A(80l),, 

GET STRING (CHt EDIT (PRI ,N,M,NS, NCARD) 



(R(FMl)), 



•/REGR 

**!***!^*ff*?********************************************************/REGR 110 

REGR 

REGR 130 
REGR 140 
REGR 

REGR 160 

REGR 170 

REGR 180 

REGR 190 

*/REGR 200 

REGR 210 

REGR 220 

REGR 230 

♦/REGR 2<.0 

♦/REGR 250 

*/REGR 260 

REGR 270 

♦/REGR 280 

REGR 290 

REGR 300 

REGR 310 

♦/REGR 320 

♦/REGR 330 

*/REGH 340 

♦/REGR 350 

♦/REGR 360 

♦/REGR 370 

♦/REGR 380 

REGR 390 

♦/REGR 400 

REGR 410 

REGR 420 

REGR 430 

REGR 440 

REGR 450 

REGR 460 

REGR 470 

REGR 480 

(R(M,M).RX(M,H),X8AR(M),RY(M),D(M),STD(M).ANS(10),FSUM,DET,C0NIREGR 490 

BINARY FLOAT,. /♦SINGLE PRECISION VERSION /•S^/REGR 500 

/•DOUBLE PRECISION VERSION /♦D*/REGR 510 

•/REGR 520 

REGR 530 

REGR 540 

REGR 550 

REGR 560 

REGR 570 

REGR 580 

I REGR 590 

REGR 600 

•/REGR 610 

•/REGR 620 

♦/REGR 6 30 

REGR 640 

REGR 650 

JOB TERMINATED* )REGR 660 

REGR 670 



/♦ NAME - PROBLEM NUMBER (HAY BE ALPHAMERIC) 

/• N - NUMBER OF OBSERVATIONS 

/» M - NUMBER OF VARIABLES 

/• NS - NUMBER OF SELECTIONS 

/* NCARD- NUMBER OF DATA CARDS PER OBSERVATION 

/* 

NCAR0=NCARD*80,. 
/• 
STRT.. 

BEGIN,. 
FM2.. 

FORMAT IPAGE.SKIP(4),COLUMN(10),A,A(6),SKIP{2),COLUMN{10(,A,A, 
F(5),SKIP(2),COLUMN(10),A,F(5),SMP(2),COLUMN(10),A,F(2)), 

DECLARE 

(X(1,1),W(M),RESI) 
FLOAT BINARY, 



BINARY FLOAT (53),. 



OPEN FILE (XDATA) OUTPUT,. 
CALL CORR IN,M,IO,X,XBAR,STD,RX,R,0),. 
CLOSE FILE (XDATA),. 
IF ERROR NE 'O' 

THEN PUT EDIT (MN ROUTINE CORR ERROR CODE = 
(SKIP(2).C0LUMNI10>,A,A(U),. 

TEST NUMBER OF SELECTIONS 



IF NS LE 
THEN 00,. 

PUT EDIT ('NUMBER OF SELECTIONS NOT SPECIFIED, 

( SKI P( 4), COLUMN (10), A),. 
GO TO S300,. 
END,. 

DO I = 1 TO NS,. 
PUT EDIT ('MULTIPLE REGRESSION ', PRI, 'NUMBER OF OBSERVA 

•T10NS...',N, 'NUMBER OF VARIABLES ',M, 

•SELECTION ',11 (R(FM2)),. 



READ SUBSET SELECTION CARD 

GET EDIT (CH) (A(80)),. 

GET STRING (CH) EDIT (NRESI ,NDEP,K) (3 F(2)),. 



KRED.. 

BEGIN,. 
FM3.. 



FORMAT (SKIP,COLUHNH0) ,F(4),7 F(14,5)l,. 

FORMAT (PAGE,SKIP(4),COLUMN(10),A,A(6),SKIP(2),COLUMN(10 
A,FI2)),. 

DECLARE 

(RZ(K,K),B(K),SB(KI,T1KI,BETA(K),RTIK)) 

BINARY FLOAT, /•SINGLE PRECISION VERSION 

BINARY FLOAT (5?), /•DOUBLE PRECISION VERSION 

(ISAVE(K+1)) 

FIXED BINARY,, 

CALL IDTl (K,ISAVE),. 

NRESI - OPTION CODE FOR TABLE OF RESIDUALS 

IF IT IS NOT DESIRED. 

1 IF IT IS DESIRED. 
NDEP - DEPENDENT VARIABLE. 

K - NUMBER OF INDEPENDENT VARIABLES INCLUDED 
ISAVE - A VECTOR CONTAINING THE INDEPENDENT VARIABLES 
INCLUDED 

CALL OROR (M,R, NDEP, K, ISAVE, RZ,RT),. 
IF ERROR NE «0' 
THEN 00,. 

PUT EDIT ('IN ROUTINE OROR ERROR CODE = ', ERROR) 
( SK I P ( 2 ) , COLUMN (10),A,A(1)).. 

GO TO S200,. 

END,. 
CON =0.0,. 
CALL MINV(RZ,K,DET,CON),. 

TEST SINGULARITY OF THE MATRIX INVERTED 

IF ERROR NE '0* 
THEN DO,. 

PUT EDITCIN ROUTINE MINV ERROR = 
C0LUMN(10),A,A11)),. 

GO TO S200,. 

END,. 



,ERROR) (SKIP(2), 



REGR 680 

REGR 690 

REGR 700 

REGR 710 

REGR 720 

REGR 730 

•/REGR 740 

•/REGR 750 

♦/REGR 760 

REGR 770 

REGR 780 

REGR 790 

REGR 600 

REGR 810 

REGR 820 

REGR 830 

REGR 840 

REGR 850 

REGR 860 

REGR 870 

/•S«/REGR 880 

/♦D^/REGR 890 

REGR 900 

REGR 910 

•/REGR 920 

REGR 930 

♦/REGR 940 

•/REGR 950 

•/REGR 960 

•/REGR 970 

*/REGR 980 

•/REGR 990 

•/REGRIOOO 

•/REGRIOIO 

♦/REGR1020 

REGR1030 

REGR 1040 

REGR1050 

REGR 1060 

REGR1070 

REGR1080 

REGR1090 

REGRllOO 

REGRlllO 

♦/REGR1120 

♦/REGR1130 

•/REGR1140 

REGR1150 

REGR1160 

REGR1170 

REGR1180 

REGR1190 

REGR1200 

•/REGR1210 
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CALL HLTR (NtK.XBAfttSTD tD.RZiRT, 1 SAVE* BtSB. T.6ET A, ANSI . . 


REGR1220 




IF ERROR NE »0' 


REGR1230 




THEN DO,. 


REGR 1240 




PUT EDIT ('IN ROUTINE MLTR ERROR CODE = •, ERROR! 


REGR1250 




($KIPI2>,C0LUMN110>.A,A(1>1>, 


REGR1260 




GO TO S200,. 


REGR1270 




END.. 


REGR1280 


/* 




*/REGR1290 


/* 


PRINT HEANSt STANDARD DEVIATIONS. INTERCORRELATIONS BETWEEN 


♦/REGR1300 


/* 


X AND Y, REGRESSION COEFFICIENTS. STANOMO DEVIATIONS OF 


♦/REGR1310 


/* 


REGRESSION COEFFICIENTS, COMPUTED T VALUES, AND BETA 


♦/REGR1320 


/* 


COEFFICIENTS. 


VREGR1330 


/* 




*/REGR1340 




MH =K+1.. 


REGR1350 




PUT EDIT CVARIABLES'HEAN'.'STANOARD'.'CORRELATION'. 


REGR 1360 




■ REGRESSION '.'STD. ERROR* » 'COMPUTED' ,' SETA' . 'NO. ' , 


REGR 1370" 




•DEVIATION'. 'X VS Y» , 'COEFFICIENT ', 'OF REG.COEFF.', 


REGR1380 




'T VALUE', 'COEFF. • 1 ( SKIPC 2) , COLUMN! 10) .A, XI 51 , A, 


REGR1390 




X(6>,A,X(6),A.XUI ,A,X(4).A,X15),A,X(7),A,SKIP, 


REGR1400 




COLUHNU2),A,X(I8!,A.X17).A.XC7l,A,X(3),A,X(3I,A, 


REGR1410 




X17I.A),. 


REGRI420 




DO J = I TO K,. 


REGR 1430 




L =ISAVE(J)*. 


REGR1440 




PUT EDIT (L,XBARIL).STDIL),RT( J),B(J),SBIJ).TIJ1.BETA(J)) REGRI450 | 




(R(FM3)).. 


REGR1460 




END.. 


REGR1470 




PUT EDIT ('DEPENDENT') (SKIP12) .COLUMN! 10) ,A) . . 


REGR 1480 




L =ISAVEIMM).. 


REGR1490 




PUT EDIT (L.XBARai.STOILl) tRIFM3)),. 


REGR1500 


/* 




*/REGR15lO 


/* 


PRINT INTERCEPT, MULTIPLE CORRELATION COEFFICIENT. AND 


*/REGR1520 


/* 


STANDARD ERROR OF ESTIMATE 


♦/REGR1530 


/* 




*/REGRl540 




PUT EDIT I'INTERCEPT'.ANSIl), 'MULTIPLE CORRELATION ',ANS(2> 


, REGR1550 




•STD, ERROR Of ESTIMATE' ,ANS (3) ) (SKIPI3) .COLUMN! 10) , 


REGR1560 




A,X(10I ,FU6,5I.(2) ( SKIP! 2), COLUMN (10),A,F (13,5))).. 


REGR1570 


/* 




♦/REGR1580 


/* 


PRINT ANALYSIS OF VARIANCE FOR THE REGRESSION 


*/REGRl590 


/♦ 




*/ReGRl600 




PUT EDIT CANALYSIS OF VARIANCE FOR THE REGRESSION •, 


REGR1610 




•SOURCE OF VARIATION', 'DEGREES', *SUM OF', 'MEAN', 


REGRX620 




• f VALUE', 'OF FREEDOM', 'SQUARES', 'SQUARES') 


REGR1630 




!SK1P!2),C0LUMN!31),A,SKIPI2),C0LUMN!15),A,XI7I,A, 


REGR1640 




X!7),A,X(I0).A.X!09),A,SKIP,COLUMN!40),A,XI4),A, 


REGR1650 




X!9) .A).. 


REGR 1660 




L =ANS(8),. 


REGR 1670 




PUT EDIT I'ATRRIBUTABLE TO REGRESSION ' ,K, ANS(4), ANSI 6) , 


REGR 1680 




ANS(IO), 'DEVIATION FROM REGRESSION 'tL.ANS!?), 


REGR1690 




ANS!9)I ISKIP,C0LUHN{101,A,FI6),3 Fl 16.5) , SKIP, 


REGR 1700 




COLUMN(10),A,FI6).2 F!16,5)).. 


REGR1710 




L =N-l.. 


REGR 1720 




FSUM =ANS!4)4-ANS!7)., 


REGR1730 




PUT EDIT! 'TOTAL', L, FSUM) (COLUMN! 15 ) .A.X( 19) ,F(6) ,F 1 16,5) ) , . 


REGR1740 




IF NRESI LE 


REGR1750 




THEN GO TO S200,. 


ReGR1760 




PUT EDIT I'MULTIPLE REGRESSION • ,PR1, ' SELECTION ',!) 


ReGRl770 




(RIFH4>),. 


REGR1780 




PUT EDIT I'TABLE OF RESIDUALS' , 'CASE NO.*,'Y VALUE', 


REGR 1790 




'Y ESTIMATE'. 'RESIDUAL') (SKIP,C0LUMN(25) ,«,SK IP! 2), 


REGR1800 




COLUMNI10),A,XI5))A,X(5t.A.X(6I.A),. 


REGR1810 




MM =ISAVE(K*1),. 


REGR1820 




OPEN FILE (XDATA) INPUT.. 


REGR 1830 




DO II = 1 TO N,. 


REGR1840 




GET FILE (XDATA) EDIT !!H(J> bO J= 1 TO M)) 


REGR1850 




!!M)F!6,0!),. 


R6GR1860 




FSUM =ANS(1).. 


REGR1870 




DO J = 1 TO K,. 


REGR1880 




L =ISAVE1J).. 


REGR 1890 




FSUM -FSUM+W!L)*B!J),. 


REGR 1900 




END,, 


REGR1910 




RESI =W(MM)-FSUM,. 


REGR 1920 




PUT EDIT !M,W!MM) , FSUM, RESI) ! COLUMN! 10 ),F ( 5) . F( 15, 5) , 


REGR 1930 




2 F(14,5)),. 


REGR1940 




END,. 


REGR1950 




CLOSE FILE (XDATA),. 


REGR1960 


GO TO SlOO,. 


REGR2010 


EXIT,, 




REGR2020 


POT 


FILE (SYSPRINT) EDIT ('END OF SAMPLE PROGRAM') 


RE6R2030 




!SKIPIS),C0LUMN(10),A),. 


RE6R2040 


S300.. 




REGR2050 


END 


/*END OF PROCEDURE REGR 


♦/REGR 20 60 



**t**********»:#i'**i'******************************* 



DAT2.. 


0AT2 


10 


/«**««««**«»:«** ««*:«4«4: «:*:*>«>«■**«**« »'*4-«1*«*«****«««**«**««««««****«******/OAT2 


20 


/* 


*/0AT2 


30 


/* TO READ FLOATING POINT DATA, ONE OBSERVATION AT A TIME. 


*/DAT2 


40 


/* DATA ><flY BE SAVED ON A DATA SET. 


♦/DAT2 


50 


/* 


•/DAT2 


60 




•**/DAT2 


70 


PROCEDURE (M.O),. 


0AT2 


80 


DECLARE 


DAT2 


90 


XDATA FILE STREAM ENVIRONMENT ICONSECUTIVE V! 2000,200) ) , 


0AT2 


100 


!NCARD,NV) EXTERNAL, 


DAT2 


110 


Ch CHARACTER!NCAR0) , 


DAT2 


120 


!I,H,HM) FIXED BINARY, 


DAT2 


130 


0!*) FLOAT BINARY,. 


0AT2 


140 


/« 


•/DAT2 


150 


ON ENOFILE ISYSINI 


DAT2 


160 


GO TO EXIT,. 


DAT2 


170 


GET EDIT !CH) (A!NCARO)),. 


DAT2 


180 


MM =CEILIM/12),. 


DAT2 


190 


GET STRING (CHI EDIT (!0!I1 00 1= I TO MI) 


0AT2 


200 


!(MM)(! 12IF!6,C}.X(8))),. 


DAT2 


210 


IF NV= 1 


0AT2 


220 


THEN PUT FILF (XDATA) EDIT !!0!I) 00 1" 1 TO Ml) < (M)F!6.0) ) . . 


DAT2 


230 


FEVERT ENDFILE (SYSIN),. 


DAT2 


240 


RETURN,. 


DAT2 


250 


EXIT.. 


DAT2 


260 


PUT FILE ISYSPRINT) EDIT ('ERROR INSUFFICIENT DATA') 


DAT2 


270 


!SKIP!1},C0LUMNI10).A),. 


OAT 2 


280 


STOP,. 


DAT2 


290 


END,, /*END OF PROCEDURE 0AT2 


*/DAT2 


300 



TO READ FIXED POINT DATA. 

***♦**#«**#*«*********»**«*♦****#**< 
PROCEDURE (M,1X),. 
DECLARE 

CH CHARACTER (80) , 

I IX(*),NF,Nl.N2.M.I) 

FIXED BINARY,, 
NF =40,. 



Nl 
N2 



= 1.. 
=NF,. 



If M LE N2 

THEN HZ =M,. 

GET EDIT ICH) (AOO)),. 

GET STRING ICH) EDIT (!!X(I) DO 1= 



Nl 



=N2+1, 



IF Nl LE M 
THEN DO,. 

N2 =N2+NF, 
GO TO SIC. 
END, . 

RETURN. . 

END,. 



IDTl 10 

***»/IDTl 20 

♦/IDTl 30 

♦/IDTI 40 

*/IDTl 50 

t************* ***«***«*****«****/ IDTl 60 

IDTl 70 

IDTl 80 

IDTl 90 

IDTl 100 

IDTl 110 

IDTl 120 

IDTl 130 

IDTl 140 

IDTl 150 

IDTl 160 

IDTl 170 

IDTl 180 

IDTl 190 

IDTl 200 

IDTl 210 

IDTl 220 

IDTl 230 

lOTl 240 

lOTl 250 

IDTl 260 

/*END Of PROCEDURE IDTl */IOTl 270 



Nl TO N2)) (!NF)f!2>},. 



STEPWISE MULTIPLE REGRESSION STEP 

Problem Description 

Stepwise multiple regression analysis is performed 
for a set of independent variables and a dependent 
variable. Selection of different sets of independent 
variables and designation of a dependent variable can 
be made as many times as desired. 

1. The sample problem for stepwise multiple re- 
gression consists of 30 observations with six variables, 
as presented in Table 1 earlier in this Appendix. 

2. The first five variables are independent vari- 
ables , and the last variable is the dependent variable. 
All five independent variables are used to predict 
the dependent variable in the first analysis , and only 
the second, third, and fifth variables are used to 
predict the dependent variable in the second analysis. 

Program 

Description 

The stepwise multiple regression program consists 
of the main routine named STEP, two special input 
subroutines named DAT2 and IDT2, an output sub- 
routine named SOUT, and two routines from the 
Scientific Subroutine Package: CORR and STRG. 

Capacity 

1. Up to 99,999 observations if observations are 
read into the computer one at a time by the special 
input routine. If all data are to be stored in core 
before the calculation of correlation coefficients, the 
limitation on the number of observations depends on 
the size of core storage available for input data. 

2. Up to 72 variables 

3. Up to 99 selections (must be greater than zero) 

4. (12 F(6, 0)) format for input data cards. There- 
fore if a problem satisfies the above conditions, the 
sample program need not be modified. If the input 
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data cards are prepared using a different format, the 
input format in the special input routine , DAT2 , 
must be modified. The general rules for program 
modifications are described later. 

Input 

Control Card 

One control card is required for each problem and is 
read by the main program, STEP. This card is pre- 
pared as follows: 



Selection Card 

The selection card is used to specify a single de- 
pendent variable and a non-null set of independent 
variables in a stepwise multiple regression analysis. 
Any variable in the set of original variables can be 
designated as a dependent variable, and any nimiber 
of variables can be specified as independent variables. 
Selection of a dependent variable and a set of inde- 
pendent variables can be performed over and over 
again using the same set of original variables. 

There must be a selection card in order for the 
program to continue. In the selection card each 







For 


variable is 


specified using one of the following codes: 






Sample 


or blank - Independent variable available for 


Columns 


Contents 


Problem 






selection 














1 


- Independent variable forced 


in 


1-6 


Problem number (may be 


SAMPLE 






regression 








alphameric) 






2 


- Variable to be deleted 




7-11 


Number of observations 


00030 




3 


- Dependent variable 




12-13 


Number of variables 


06 












14-15 


Number of selections 


02 








For Sample Problem 


16-20 


A constant value of pro- 


0.0 


Columns 


Contents 


Selection 1 


Selection 2 




portion of sum of squares 
















that will be used to limit 




1 




First variable 





2 




variables entering in the 




2 




Second variable 










regression 




3 




Third variable 








21 


Option code for table of 


1 


4 




Fourth variable 





2 




residuals 




5 




Fifth variable 










- if it is not desired 




6 




Sixth variable 


3 


3 




1 - if it is desired 








• 






22-23 


Number of cards per 
observation 


1 






• 







Leading zeros do not have to be ke5rpunched. 

Data Cards 

Since input data is read into the computer one obser- 
vation at a time , each row of data in table is key- 
punched on a separate card using the format (12 F 
(6, 0)). This format assumes twelve 6-column 
fields per card. If there are more than twelve vari- 
ables in a problem , each row of data is continued on 
the next card until the last data point is keypimched. 
However, each row of data must begin on a new card. 



72 



72nd variable 



Leading zeros do not have to be ke5rpxmched. If more 
than 72 selections are made , continue selection 
specification codes beginning in coliunn 1 of a second 
card. 

Deck Setup 

Deck setup is shown in Figure 17. 
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IDT2 



DAT2 



STRG 



CORR 



7i-y 



STEP 




Last problem 



Second problem 



First problem 



SOUT 



Procedures and main progrom 



Figure 17. 

Sample 

The listing of the input cards for the sample problem 
is shown in Figure 18. 



SAMPLECCC3C060 


2 C 


01 1 






10 






2lt 


65 




1 








244 


<;2 




2 


30 






246 


90 




2 


40 






239 


91 







50 






275 


95 




2 








219 


95 




2 








267 


100 




3 








274 


79 




2 








255 


126 




3 


100 






258 


55 







lie 






24S 


lie 




4 








252 


8B 




t 


130 






236 


129 




1 








236 


97 




1 


150 






256 


111 




3 








262 


94 




2 








339 


96 




3 








357 


68 




4 








198 


147 




4 


200 






206 


1C5 




3 


210 






245 


132 




4 








225 


1C8 




4 


230 






215 


ICl 




1 








220 


136 













205 


113 




4 


260 






215 


88 




1 








215 


1L8 




3 


280 






21C 


116 




4 




51 




210 


140 


59 


4 


300 


51 


iSC 


210 


1C5 


3C 





310 


C00003 














2CC2C2 












330 



Output 

Description 

The output of the sample program for stepwise mul- 
tiple regression includes: 

1. Means 

2. Standard deviations 

3. Correlation coefficients between independent 
variables and dependent variables 

4. Sum of squares reduced in the step 

5. Proportion reduced in the step 

6. Multiple correlation coefficient 

7. F value for analysis of variance 

8. Standard error of estimate 

9. Computed T value 

10. Beta coefficients 

11. Table of residuals (optional) 

Sample 

The output listing for liie sample problem is shown 
in Figure 19. 



STeP-WIS£ multiple regression SAMPLE 








NUMBER OF OBSERVATIONS 30 
NUMBER OF VARIABLES 6 
NUMBER OF SELECTIONS 2 








CONSTANT TO LIMIT VARIABLE O.OOOOC 








VARIABLE MEAN STANDARD 
NO. DEVIATION 

1 43.13333 6.52176 

2 316.16650 I14.4299C 

3 241.79999 36.43074 

4 105.66666 17.85640 

5 34.13333 15.97571 

6 2.26667 1.41259 








CORRELATION MATRIX 








ROW 1 

l.OOOOC -C. 06721 -C. 13689 


0.49755 


0.55849 


0.28422 


ROW 2 

-0.06721 l.OOOOO -C. 17857 


-0.05227 


-0.18381 


0.42189 


ROW 3 

-0.13689 -0.17857 I.OOOCO 


-0.40874 


-C. 26319 


0.11900 


ROW 4 

0.49755 -0.05227 -0.40874 


l.COOOO 


0.93552 


0.37822 


ROW 5 

0.55849 -0.18381 -C. 26319 


0.93552 


l.COOOO 


0.39412 


ROW 6 

0.28422 0.42189 G.119CC 


0.37822 


0.39412 


l.OOOOO 


SELECTION 1 
















NUMBER OF VARIABLES FORCED.... 
NUMBER OF VARIABLES DELETED... C 


STEP 1 








VARIABLE ENTERED 2 








SUM OF SQUARES REDUCED IN THIS STEP.... 
PROPORTION REDUCED IN THIS STEP........ 


10 

C 


300 
178 




CUMULATIVE SUM OF SQUARES REDUCED 

CUMULATIVE PROPORTION REDUCED 


10 


3C0 




FOR 1 VARIABLES ENTERED 

MULTIPLE CORRELATION COEFFICIENT... 

(ADJUSTED FOR D.F.I 

F-VALUE FOR ANALYSIS OF VARIANCE... 


0.422 
0.422 
6.063 
1.303 
1.3C3 






(ADJUSTED FOR D.F.) 


VARIABLE REGRESSION STO. ERROR OF 
NUMBER COEFFICIENT REG. COEFF. 
2 0.00521 0.00212 
INTERCEPT C. 62005 


COMPUTED 
T-VALUE 
2.462 


BETA 

COEFFICIENT 

0.42189 



Figure 18. 



Figure 19. 
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STEP 2 

VARIABLE ENTERED 5 



SUM OF SQUARES REDUCED IN THIS STEP.... 13,324 

PROPORTION REDUCED IN THIS STEP 0,230 

CUMULATIVE SUM OF SQUARES REDUCED 23.624 

CUMULATIVE PROPORTION REDUCED C.4C8 

FOR 2 VARIABLES ENTERED 

MULTIPLE CORRELATION COEFFICIENT,.. 0.639 

(ADJUSTED FOR D.F.) 0.622 

F-VALUE FOR ANALYSIS OF VARIANCE... 9.314 

STANDARD ERROR OF ESTIMATE 1.126 

(ADJUSTED FOR D.F.) 1.146 



VARIABLE 


!:EGRESSI0N 


STO. ERROR OF 


COMPUTED 


BETA 


NUMBER 


COEFFICIENT 


REG. COEFF. 


T-VALUE 


COEFFICIENT 


2 


0.00632 


0.00186 


3.397 


0.51162 


5 


0.04316 


C.01332 


3.241 


0.48817 


INTERCEPT 


-1.20349 









STEP 3 

VARIABLE ENTERED 3 



SUM OF SQUARES REDUCED IN THIS STEP.... 
PROPORTION REDUCED IN THIS STEP 

CUMULATIVE SUM OF SQUARES REDUCED 3 

CUMULATIVE PROPORTION REDUCED 

FOP 3 VARIABLES ENTERED 

MULTIPLE CORRELATION COEFFICIENT... 0.734 

(ADJUSTED FOR D.F,) 0.711 

F-VALUE FOR ANALYSIS OF VARIANCE.., 10.137 

STANDARD ERROR OF ESTIMATE 1.013 

(ADJUSTED FOR D.F.) 1.050 



7.572 
0.131 



VARIABLE 



REGRESSION 

COEFFICIENT 

0.00744 

0,05363 

0.C1497 

-5.535?9 



STD. ERROR OF 
PEG. COEFF. 

C. 00172 
0.01258 
0.00551 



T-VALUE 
4.318 
4.263 
2.717 



STEP 4 

VARIABLE ENTERED. 



SUM OF SOUAFES PEOUCEO IN THIS STEP,,.. 
PROPORTION REDUCED IN THIS STEP 

CUMULATIVE SUM OF SQUARES REDUCED 

CUMULATIVE PFOPORTION KEDUCEO 

FOR 4 VARIABLES ENTERED 

MULTIPLE CORRELATION COEFFICIENT.,, 0,736 

(ADJUSTED FOR 0,F.) 0.699 

F-VALUE FOR ANALYSIS OF VARIANCE... 7.375 

STANDARD ERROR OF ESTIMATE 1.03C 

(ADJUSTED FOR D.F.) 1.098 



31.323 
C.541 



STEP 5 

VARIABLE ENTERED 4 



SUM OF SQUARES REDUCED IN THIS STEP.... C.CC2 

PROPORTION FEDUCEO IN THIS STEP C.COC 

CUMULATIVE SUM OF SQUARES REDUCED 31.325 

CUMULATIVE PROPORTION CEDUCED C.541 

FOP 5 VARIABLES ENTERED 

MULTIPLE CORRELATION COEFFICIENT... 0.736 

(ADJUSTED FOR O.F.) 0.684 

F-VALUE FOR ANALYSIS OF VARIANCE... 5.665 

STANDARD EROOR OF ESTIMATE 1.C52 

(ADJUSTED FOR D.F.) 1.133 



BETA 
COEFFICIENT 

0.60233 
0.60648 
0.38618 



VARIABLE 


REGPESSION 


STD 


ERROR OF 


COMPUTED 


BETA 


NUMBER 


COEFFICIENT 


REG 


COEFF. 


T-VALUE 


COEFFICIENT 


2 


C.0C741 




0.00175 


4.222 


0.59997 


5 


0.C5O76 




0.01524 


3.332 


0.57411 


3 


C,C1493 




C. 00561 


2.662 


0.38499 


1 


0.C1226 




0.03541 


0.346 


0,05661 


INTERCEPT 


-5.94617 











VARIABLE 


REGRESSION 


STO 


ERROR OF 


COMPUTED 


BETA 


NUMBER 


COEFFICIENT 


PEG 


COEFF. 


T-VALUE 


COEFFICIENT 


2 


0.C0739 




C, 00186 


3.965 


0.59826 


5 


C. 04919 




C. 04141 


1.188 


0.55632 


3 


O.C1504 




C. 00635 


2.369 


0.3S79C 


I 


0.C1242 




C, 03635 


C.342 


0.05735 


4 


0.00151 




0.03679 


G.041 


0.01907 


INTERCEPT 


-6.C7929 











STEP-WISE MULTIPLE REGRESSION SAMPLE 



SELECTION 


1 








TABLE 


OF RESIDUALS 




CASE NO. 


Y VALUE 


Y ESTIMATE 


RESIDUAL 


I 


l.COOOO 


0,48090 


0,5191C 


2 


2.00000 


l,7767C 


0.22330 


3 


2.00000 


2.14586 


-0,14586 


4 


0.00000 


0,82880 


-0.82880 


5 


2.00000 


1.90522 


C. 0947 8 


6 


2.00000 


1.52125 


0.47875 


r 


3.00000 


3.46447 


-0.46447 


3 


2.OC0OO 


2.25887 


-0.25887 


9 


3.00000 


3.80259 


-0.60259 


10 


0. 00000 


1,02042 


-1,02042 


11 


4.C0000 


2.49735 


1.50265 


12 


l.QOOOO 


2,00065 


-1.00065 


13 


1,00000 


2.00736 


-1.00736 


14 


1.00000 


1.15308 


-0.15308 


15 


3.C0000 


2.90446 


0.09554 


16 


2.00000 


1.83531 


0.16469 


17 


3,00000 


2.560C4 


0.43996 


10 


4.00000 


3.45228 


0.54772 


19 


4.00000 


3.62661 


0.37339 


2C 


3,00000 


2.68068 


0.31932 


21 


4.00000 


3.64886 


0.35114 


22 


4.00000 


1.86541 


2,13459 


23 


1,00000 


2.09863 


-1.09863 


24 


c.coooo 


1.97217 


-1.97217 


25 


4.000C0 


1.41254 


2.58746 


26 


l.COOOO 


1.88027 


-0.86027 


27 


3.00000 


2.27646 


0.72354 


28 


4.00000 


4.51080 


-0.51CB0 


29 


4.00000 


3.95746 


0.04254 


3C 


O.COOOQ 


0.45458 


-0.45458 


STEP-WISE 


MULTIPLE REGRESSION SAMPLE 



SELECTION 2 



DEPENDENT VARIABLE 

NUMBER OF VARIABLES FORCED,., 
NUMBER OF VARIABLES DELETED.. 



STEP 1 

VARIABLE ENTERED 2 



SUM OF SQUARES REDUCED IN THIS STEP.... 
PROPORTION REDUCED IN THIS STEP 

CUMULATIVE SUM OF SQUARES REDUCED 

CUMULATIVE PROPORTION REDUCED 

FOR 1 VARIABLES ENTERED 

MULTIPLE CORRELATION COEFFICIENT... 0.422 

(ADJUSTED FOR D.F.) C.422 

F-VALUE FOR ANALYSIS OF VARIANCE,.. 6.063 

STANDARD ERROR OF ESTIMATE 1.303 

[ADJUSTED FOP D.F.) 1.303 



1C.3CC 
0.178 



VARIABLE 


REGRESSION 


STO 


ERROR OF 


COMPUTED 


BETA 


NUMBER 


COEFFICIENT 


REG 


COEFF. 


I-VALUE 


COEFFICIENT 


2 


0.00521 




0,00212 


7.462 


0.42189 


INTERCEPT 


0.62005 











STEP 2 

VARIABLE ENTERED 5 



SUM OF SQUARES REDUCED IN THIS STEP..., 
PROPCRTION REDUCED IN THIS STEP 

CUMULATIVE SUM OF SQUARES REDUCED 

CUMULATIVE PROPORTION gEDUCEO 

FDR 2 VARIABLES ENTERED 

MULTIPLE CORRELATION COEFFICIENT... C.639 

(ADJUSTED FOR O.F.) C.622 

F-VALUE FOR ANALYSIS OF VARIANCE.., 9.314 

STANDARD ERROR OF ESTIMATE 1.126 

(ADJUSTED FOR O.F.) 1.146 



VARIABLE 
NUMBER 



REGRESSION 
COEFFICIENT 

0. 00632 

0.04316 

-1.20349 



STD. ERROR OF 
REG. COEFF. 

0. or 186 
0.01332 



23.624 
C.4C8 



COMPUTED 
T-VALUE 

3,397 

3.241 



BETA 

COEFFICIENT 
0.51162 
0.48817 



STEP 3 

VARIABLE ENTERED, 



SUM OF SQUARES REDUCED IN THIS STEP 

PROPORTION REDUCED IN THIS STEP 

CUMULATIVE SUM OF SQUARES REDUCED 

CUMULATIVE PROPORTION REDUCED 

FOR 3 VARIABLES ENTERED 

MULTIPLE CORRELATION COEFFICIENT,.. 0.734 

(ADJUSTED FOR D.F.) 0.711 

F-VALUE FOR ANALYSIS OF VARIANCE... 10.137 

STANDARD ERROR OF ESTIMATE 1,013 

(ADJUSTED FOR O.F.) 1.050 



VARIABLE 



REGRESSION 

COEFFICIENT 

0.00744 

0.05363 

0,01497 

-5.53529 



STD. ERROR OF 

REG. COEFF. 

0.00172 

0.01258 

0.00551 



31.196 
0.539 



T-VALUE 
4.318 
4.263 
2.717 



BETA 

COEFFICIENT 
0.60233 
0.60648 
0.36618 



Figure 19. (Continued) 



Figure 19. (Continued) 
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MULTIPLE PEGFESSION SAMPLF 




.... 2 

TABLE OF RESIDUALS 




Y VALUE 


Y ESTIMATE 


RESIDUAL 


1.00000 


0.59669 


0.40131 


2.00000 


1.88363 


0.11637 


2.00000 


2.26620 


-C.2662C 


C. 00000 


0.90704 


-C. 90704 


2.C0000 


1.99813 


C.CC167 


2.0000C 


1.584C8 


C.41592 


3.0C00C 


3.49859 


-C.49859 


2.00000 


2.23348 


-0.23348 


3.CC0OC 


3.8587f. 


-0.85876 


O.COOOO 


C, 93943 


-0.98943 


4.00000 


2.51255 


1.48745 


1.00000 


1.95926 


-C. 95926 


l.COOOO 


2.C4998 


-1.C4998 


1.00000 


1.10726 


-C. 10726 


3.00000 


2.91951 


C.08C49 


2.00CCO 


1.76539 


C. 2 3461 


3.000CC 


2.54052 


0,45948 


4.C0O0C 


3.36591 


0.63409 


4.00000 


3.67961 


C. 32039 


3.00000 


2.65435 


0.3456= 


4.0000C 


3.70045 


0.29955 


4.C000C 


1,84629 


2.15371 


l.COOOO 


2,0690C 


-1,0690C 


P.COOOO 


1.95640 


-1.9564f 


4.00000 


1.34020 


2. 65980 


l.CGOOO 


1.79817 


-0.79817 


3.CO0OO 


2.24542 


C. 75458 


4.C000C 


4.41268 


-C. 41268 


4.COOC0 


3.92577 


0.07423 


O.COOOO 


C. 33332 


-0.33332 



END OF SAMPLE PROGRAM 



Figure 19, (Continued) 



Program Modifications 

Input data in a different format can be handled by 
providing a special format statement. The special 
input routine, DAT 2 is normally written by the user 
to handle different formats for different problems. 
The user may modify this routine to perform test- 
ing of input data, transformation of data and so on. 
When doing so, attention should be paid to the format 
statement in DAT2 (DAT2 230), which writes on the 
intermediate data set. The format in this statement 
must be the same as the format in statement STEP 
1390. 

Operating Instructions 

The sample program for stepwise multiple regression 
is a standard PL/I program. Special operating in- 
structions are not required. Data set SYSIN is used 
for input; data set SYSPRINT, for output. A scratch 
tape (data set XDATA) is used as intermediate 
storage. 

Error Messages 

The following error condition will result in a 
message: 

1. The number of selections not specified on the 
control card: NUMBER OF SELECTIONS NOT SPECI- 
FIED. JOB TERMINATED. 



Timing 

The execution of this sample program on a System/360 
Model 40, using an IBM 2540 Card Reader as input and 
an IBM 1403, Model NX, as output, is 41 seconds. 



STEP.. 



STEP 

*»«*****************»»**********»*****************'STEP 

♦/STEP 

TO READ THE PROBLEM PARAMETER CARD FOR A STEP-WISE R6GR£SSI0N*/STEP 
READ SUBSET SELECTION CARD, CALL THE PROCEDURES TO CALCULATE */STEP 
MEANS. STANDARD DEVIATIONS. AND THE PROCEDURE THAT PERFORMS •/STEP 
STEP-WISE REGRESSION. 



/STEP 70 
♦/STEP 60 
♦/STEP 90 
STEP 100 
STEP 110 
, STEP 120 
STEP 130 
STEP 140 
STEP 150 
STEP 160 
STEP 170 
♦/STEP 180 
STEP 190 
STEP 200 
STEP 210 
F(2). STEP 220 
STEP 230 
♦/STEP 240 
♦/STEP 250 
♦/STEP 260 
PROBLEM CODE (MAY BE ALPHAMERIC! *'fl!« lln 

NUMBER OF OBSERVATIONS ,„ „ !!„ 

NUMBER OF VARIABLES HVtIo II?, 

- NUMBER OF SELECTIONS ^ ^, 1,1111 t,?, 

A CONSTANT VALUE OF PROPORTION OF SUM OF SQUARES THAT ♦/STEP 310 
WILL BE USED TO LIMIT VARIABLES ENTERING IN THE •*^^'*ES-VSTEP 320 
SION 
NR - OPTION CODE FOR TABLE OF RESIDUALS 

- IF IT IS NOT DESIRED 

1 - IF IT IS DESIRED 
NCARD - NUMBER OF DATA CARDS PER OBSERVATION 



/♦»♦«♦»***«♦«»»*•♦*♦♦♦♦♦♦♦*♦*♦♦♦**♦♦♦♦*♦*♦♦♦♦♦♦♦♦♦♦*•••*♦******' 
PROCEDURE OPTIONS (MAIN),. 

XDATA FILE STREAM ENVIRONMENT (CONSECUTIVE V(2000,200)) 

(I.IO.J.K.KK.M.MM.N.NR.NS.NSEL) FIXED BINARY, 

PRl CHARACTER (6). 

(NCARD, NVI EXTERNAL, 

ERROR EXTERNAL CHARACTER ID. 

CH CHARACTER (80!,. 
/♦ 

ON ENOFILE (SYSIN! GO TO EXIT,, 
SIOO.. 

GET EDIT ICH! (A(80ll.. 

GET STRING (CH! EDIT (PRl ,N,M,NS, PCT.NR. NCARD! (A(6!,F(5» 

F(6«0!,F(11,F(2}1,. 
/* 

/♦ READ PROBLEM PARAMETER CARD 
/♦ 
/♦ PRl 



PCT 



NV =NR., 

NCARO^NCARD^eO,. 
/* 

PUT EDIT ('STEP-WISE MULTIPLE REGRESSION '.PRl! 

(PAGE,C0LUMN(10!«A.A).. 

PUT SKIP(2!.. 

PUT EDIT ("NUMBER OF OBSERVATIONS* .N! (R(FM1>I,. 

PUT EDIT ('NUMBER OF VARIABLES ',M! (R(FH11!.. 

PUT EDIT ('NUMBER OF SELECTIONS '.NSI (R(FMl!).. 
FHl.. 

FORMAT (SKlP(l!,COLUMNilO!.A,F(51!t. 

PUT EDIT ('CONSTANT TO LIMIT VARIABLE' .PCT» 
(SKIP(2!>C0LUHN( 101 ,A.F (9,51 ], . 
ONE.. 

BEGIN.. 

(XBAR(Ml,STO(MI,D(M!.BIM!,RXIM,M!,R(M,M!,ANS(ll!,Xll,l!, 

BINARY FLOAT, /♦SINGLE PRECISION VERSION 

/* BINARY FLOAT (531, /*DOUBLE PRECISION VERSION 

tIDXtHl,L(H!,NSTEP(5!! FIXED BINARY,. 



10 



=0, 
=0t. 



OPEN FILE (XDATA! OUTPUT,. 
CALL CORR {N,M,10,X.XBAR,STD,RX,R,B!.. 
CLOSE FILE (XDATA! ,. 
IF ERROR N£ '0' 

THEN PUT EDIT ('IN ROUTINE CORR ERROR CODE = '.ERROR! 
ISKIP(2),COLUMN(101,A,A(1!1,. 

PRINT MEANS AND STANDARD DEVIATION 

PUT EDIT (>VARIABLe','MEAN', 'STANDARD' , 'NO.', 'DEVIATION' 1 

{SKIP(2!,COLUMN(101,A.X(5!.A,XI5I,A.SKIP,COLUHN113),A,X(16! 

.A!.. 

00 I = I TO M,. 

PUT EDIT (I.XBARdl.STDdl) (SKIP,CQLUMN( 13 1 ,F ( 2! .F (14, 51 , 



PRINT CORRELATION MATRIX 

PUT EDIT ('CORRELATION MATRIX' 1 ( SKIP! 2 I .COLUHNdOl , A) 

DO I = I TO M,. 

PUT EDIT CROW', 11 (SKIPI2 I , COLUMN (10! , A.Fl 31 ) 

PUT EDIT KRII.Jl 00 

END.. 
IF NS LE /* TEST NUMBER OF SELECTKWS 

THEN DO,. 

PUT EDIT ('NUMBER OF SELECTIONS NOT SPECIFIED' 1 
(SKIP (2 I ,COLUMN(101,A1,. 

GO TO S200,. 

END... 

' SAVE THE MATRIX OF SUMS OF CROSS-PRODUCTS OF DEVIATION 



I TO nil (SKIP,COLUMN(101,9 F(12,511 



NSEL =1.. 
GO TO S150,, 



COPY THE MATRIX OF SUMS OF CROSS-PRODUCTS OF DEVIATIONS 



S150.. 

PUT EDIT ('SELECTION. 
CALL IDT2 (M.IDXl .. 



/» READ A SELECTION CARD 
, NSEL ! ( SKIP ( 3 1 ,COLUMN( 10 1 . A,F ( 2 1 ! . 



ONE OF THE FOLLOWING COOES MUST BE 



IN EACH POSITION OF IDX 
SPECIFIED. 

OR BLANK - INDEPENDENT VARIABLE AVAILABLE FOR SELECTION 

1 - INDEPENDENT VARIABLE TO BE FORCED IN REGRES- 

SION 

2 - VARIABLE TO BE DELETED 

3 - DEPENDENT VARIABLE 



♦/STEP 330 
♦/STEP 340 
♦/STEP 350 
♦/STEP 360 
♦/STEP 370 
♦/STEP 380 
STEP 390 
STEP 400 
♦/STEP 410 
STEP 420 
STEP 430 
STEP 440 
STEP 450 
STEP 460 
STEP 4T0 
STEP 480 
STEP 490 
STEP 500 
STEP 510 
STEP 520 
STEP 530 
STEP 540 
STEP 550 
STEP 560 
/♦S*/STEP 570 
/♦D^/STEP 580 
STEP 590 
STEP 600 
STEP 610 
STEP 620 
STEP 630 
STEP 640 
STEP 650 
STEP 660 
STEP 670 
♦/STEP 680 
♦/STEP 690 
♦/STEP 700 
STEP 710 
STEP 720 
STEP 730 
STEP 740 
STEP 750 
STEP 760 
STEP 770 
♦/STEP 780 
♦/STEP 790 
♦/STEP 800 
STEP 810 
STEP 820 
STEP 830 
, STEP 840 
STEP 850 
♦/STEP 860 
STEP 870 
STEP 880 
STEP 890 
STEP 900 
STEP 910 
♦/STEP 920 
♦/STEP 930 
♦/STEP 940 
STEP 950 
STEP 960 
STEP 970 
♦/STEP 980 
♦/STEP 990 
♦/STEPIOOO 
STEPIOIO 
STEP1020 
♦/STEP1030 
STEP1040 
STEP1050 
♦/STEP1060 
♦/STEP1070 
♦/STEP1080 
♦/STEP1090 
♦/STEPllOO 
♦/STEPlllO 
♦/STEP1120 
♦/STEP1130 
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• CALL THE PROCEDURE TO PERFORM A STEP-WISE REGRESSION ANAlyS 

CALL STRG IM,N,RX,X6AR,IDX,PCT,NSTEP,ANS,L,e,ST01, . 
IF ERROR NE *0' 

THEN PUT EDIT CIN ROUTINE STRG ERROR CODE • '.ERROR) 
ISKIPI2),C0LUIINI10I,A,A(1II.. 

> FIND WHETHER TO PRINT THE TABLE OF RESIDUALS 

IF NR LE 

THEN GO TO SI85t. 

• PRINT TABLE OF RESIDUALS 

t 

PUT EDIT CSTEP-HISE HOLTIPLE REGRESSION '.PRl) 

(PAGE.COLUHNIlOltA.AI,. 

PUT EDIT ('SELECTION '.NSELI ISKIP(31,C0LUHNU0I,A,F(2) I ,. 

PUT EDIT ('TABLE OF RESIDUALS' , -CASE NO.'.'V VALUE', 'Y ESTIMATE' 

'RESIDUAL') 

(SKIP(2),C0LU«N(26),A,SKIP(2),CGLUMN(10),A,XI5),A,X(5),A, 

MH =NSTEP(l),. 

OPEN FILE IXOATAI INPUT,. 

00 I » 1 TO N,. 

GET FILE (XOATA) EDIT l(0(J) DO J= 1 TO H)) ( (M)F(6,0)) ,. 

VEST >ANSI9) ,. 



K .NSTEPI«),. 




DO J " 1 TO K,. 




KK .L(J),. 




VEST =YESI»B(J)»0(KK),. 




END,. 




RESI «0(HH)-YEST,. 




PUT EDIT (I.DINH) ,YEST,RESI) (COLUMN(IO) 

2 f(14,5)),. 
END.. 


F(51,F(I5,5), 




CLOSE FILE (XOATA),. 




/♦ 




/• TEST WHETHER ALL SELECTIONS ARE COHPLETEO 

sias.. 







IF NSEL LT NS 
THEN 00.. 

NSEL -NSEL4^1,. 

PUT EDIT ('STEP-WISE MULTIPLE REGRESSION 

(PAGE,COLUHN(10),A,A),. 
GO TO S145f. 
ENDt, 
ENOf . 

GO TO SlOO,, 
EXIT.. 

PUT FILE (SVSPRINTJ EDIT PENO OF SAMPLE PROGRAM* 
(SKIP(51,C0lUMNU0)tAI.. 
S200.. 
ENOf. 



/•END OF PROCEDURE STEP 



♦/STEP1140 
ISVSTEPU50 
VSTEP1160 
STEP1170 
STEPU80 
ST6P1190 
STEP1200 
♦/STEP1210 
*/STEP1220 
*/STEPl230 
STEP1240 
STEP1250 
*/STEP1260 
*/SrEPl270 
♦/SrEP1260 
STEP1290 
STEP1300 
STEP1310 
STEP1320 
STEPI330 
STEP1340 
STEPI350 
STEP1360 
STEPU70 
STEPI380 
STEP1390 
STEPI400 
STEP1410 
STEP14Z0 
STEP1430 
STEP1440 
STEP1450 
STEP1460 
STEP1470 
STEP1460 
STEPX490 
STEPISOO 
•/STEPISIO 
•/STEP1520 
♦/STEP1530 
STEP1540 
STEP1550 
STEP1560 
STEP1570 
STEP1580 
STEP1590 
STEP1600 
STEP1610 
STEP1620 
STEP1630 
STEP 1640 
STEP1650 
STEPU^O 
STEP1670 
*/STEP1680 



'**********t***t**t***** 



0AT2.. 

/* 

/* TO READ FLOATING POINT DATA, ONE OBSERVATION AT A TIME 

/♦ DATA HAY BE SAVED ON A DATA SET. 

/•**«****««**«**,*»,*,,#*„„„»^,^,^,^^^^^^^^^^^^^^^ 
PROCEDURE (M,D>,, 
DECLARE 

XOATA FILE STREAM ENVIRONMENT (CONSECUTIVE Vt2000,200M, 

(NCARD.NVI EXTERNAL, 't^^w.^uui i , 

CH CHARACrERtNCARDI, 

(1,M,MM) fIXEO BINARY, 

01*1 FLOAT BINARY,. 
/* 

ON ENOFILE (S^SIN) 

GO TO EXIT,. 

GET EDIT (CH) ^AINCAROJ),. 

rtM =CE1LIM/I2t,. 

GE-. STRING (CH) EPn ( n», , ^ DO 1= i TO MM 

flMMMd ;)J-(6,CJ , ..oJIJ,, 
IF MV= I 

TH^fi PUT FILE UJtTAi EDIT lIDd) DO 1= 1 TO M) ) ( ( M) F |6, 0) I . . 
REVERT ENDFILE (SYSIN),. <r.o,u.,.. 

RETURN, , 
EXIT.. 

PUT FILE (SYSPRINT) EDIT ('ERROR INSUFFICIENT DATA') 

(SKIP(l),COLUMN(lO),A},. 
STOP,. 

^'*'°" /»LNL' OF PROCEDURE 0AT2 



DAT2 10 

•*/0AT2 20 

*/0AT2 3C 

•/D4T2 40 

*/DAT2 50 

*/DAT2 60 

♦ VDAT2 70 

0AT2 80 

DAT 2 90 

OflT2 100 

DAT2 110 

DAT2 120 

t)AT2 130 

0AT2 140 

*/DAT2 150 

0AT2 160 

0AT2 170 

DAT2 160 

0AT2 190 

DAT2 200 

0AT2 21C 

0AT2 220 

DAT2 230 

0AT2 240 

0AT2 250 

DAT2 260 

DAT2 270 

0AT2 280 

DAT2 290 

*/DAT2 300 



/* 

/* TO READ FIXED POINT DAI*,. 

PROCEDURE (M,IX),. 
DECLARE 

CH CHARACTER (80) , 

( IX(*l,NF,Nt N2,M,n 

FIXED BINARY*. 

=72,. 



IDT2 

*/I0T2 
*/IDT2 
*/IDT2 

I0T2 



Nl 
N2 



= 1, 
=NF, 



IF M LE N2 

THEN N2 =M,, 

GET EDIT ICH) (A(80)),. 

GET STRING (CH) EDIT ((iX(I) DO 1= 

NX =N2+1,. 

IF Nl LE 



NI TO N2)) (<NF)FI1)),; 



THEN 


00,. 






N2 


=N2+NF,. 




GO TO 


SIO,. 




END,. 




RETURN.. 




END, 







/•END OF PROCEDURE I0T2 



IDT2 
rDT2 
I0T2 100 
I0T2 110 
IDT2 120 
IDT2 13C 
10T2 140 
IDT2 150 
1DT2 160 
IDT? 170 
IDT2 180 
IDT2 190 
1072 200 
I0T2 210 
I0T2 220 
I0T2 230 
I0T2 240 
IDT2 250 
1DT2 260 
*/I0T2 270 



'*4****t**tL*,tt:*******:* 



in PRINT THE RESULTS OF A STEP-MISE MULTIPLE REGRESSION. 



*••****»»«•****♦*«»»* 



'SINGLE PRECi;iGhi VERSION 

■OOUei€ PRECISTDM VERSION 



1^.^ 



PROCEDURE (NSTEP,ANS,L,6,S,T,8£TA),. 
DECLARE 

NSTOP EXTERNAL CHARACTER (1), 
(ANS(*1,B(*),S(«),T(*),BETA(*)| 
BINARY FLOAT, / 

* t,H&RY FLOAT (53) , / 

(r>tSTEP(*l,L(*),l ,NI 
FIXED BINARY, , 

TEST WHETHER THIS IS THE FIRST 

IF NSTEP(4) LE 1 
THEN DO,. 

PUT EDIT ('DEPENDENT VARIABLE '.NSTEPdM 

(SKIP(2J,COLUMNilO),A,F{2)),. 
PUT EDIT f'NUMBEft OF VARIABLES FORCED. ...• ,NSTEP( 2) ) 

(SK1P,COLUMN110) ,A,F(2I),. 
PUT EDIT CNUMPfP OF VARUBLSS DELET ED. . . ■ , NSTEP( 3) ) 

(SKIP,COLU.1N(10) ,A,F(2» I,. 
END, . 
/* 

/* PRINT THE RESULTS OF A STEP 

/* 

PUT EDIT ('STEP',NSreP(4)) ( SKI P ( 5 ) ,C0' UMNI lOi , A,F( 3) } , . 
PUT EDIT ('VARIABLE ENTERED. ...■•, JSTEt>( 5 1 5 •'"»• 

(SKiP(2),CnLUMN( 10) ,A,F(2I) , . 
PUT SKIP(2I,. 
IF f:ST£P(4) LE NSTEP(21 

THEN PUT EDIT {■ (FOpCEO VAfilABLFC) ( SK 1P,C0LUMN( 10) , A ) , . 
PUT EDIT CSUM OF SCUAPES REDUCED IN THIS STEP. . . . • , ANSI 1 ) I 
(R(FM1U,. iA"i3»i/i 

FMl. . 

FO«MAT (SKIP) n,COLUHN(10),A,F(13,3J ),. 

PU^ EDIT CPcOPORTiriN REDUCED IN THIS STEP •.ANS(2)) 

PUV SKIP(2),. 

PUT EDIT ('CUMULATIVE SUM OF SQUARES REDUCED •.ANS(3)) 

(R{FMl) ),, 
PUT EDIT ('CUMULATIVE PROPORTION REDUCED •,ANS(4).' 

ANSI 5)) (SKIP,COLUMN(I0),A,F(13,3),A,F«13,3n,. 
PUT EDIT ( 'F0R',NSTEP(4),' VARIABLES ENTERED") 

(SKIP(2),C0LUMN( 10) ,A ,F( 3) , A ) , . 
PUT EDIT ('MULTIPLE CORRELATION COEFF IC lENT . . . • , ANS ( 6) I 

(SKIP(1),C0LUMN( 12),A,F(9,3)),. 
PUT EDIT ('(ADJUSTED FOR D.F.). ',ANS(10)) 

(SKIP(1),C0LUHN(17),A,F(9,3)),. 
PUT EDIT CF-VALUE FOR ANALYSIS OF VARI ANCE. . . ' .ANSI 7) 1 

(SKIP(n,C0LUMN(l2),A,F(9,3)),. 
PUT EDIT ('STANDARD ERROR OF ESTIMATE ', ANSIS)) 

(SKIP(1),C0LUMN(12),A,F(9.3)I,. 
PUT EDIT ('(ADJUSTED FOR D.F.) ',ANSI11)) 

(SKIP(1),CCLUMM17),A,F(9.3)»,. 
PUT EDIT ('VARIABLE', 'REGRESSION', 'STO. ERROR OF '.'COMPUTED*, 

'BETA', 'NUMBER', 'COEFFICIENTS'REG. COEFF. ', 'T-VALUE' . 

•COEFFICIENT') '""'' ' 

!?M'*I^i:^?'-i'"''!^?''^'*»'''5"'SKlP(l),COLUMN(13),A,X(6),A, 
A(<t],A,X(6) .A,X(6),A) f. 
N =NSTcPE4),, 

00 i = S TO "J . 

PUT EDIT (Ld), 8(11, Sm, Tin, BETA(I)) (SKIP( 1 ) .COLUMNI 14), 

F(3J,F(I8,5),F(16v5),Fd4,3),Fd4,5)),. 
END, . 

J^J^DIT^C INTERCEPT '.ANSI? J) I SKIP,C0LUMNd2) . A,FI14,S) ) , . 

RETURN, . 

^'*'°" /*Ehi0 OF PROCEDURE SOUT 



SOUT 

«**/SOUT 

*/SOUT 

*/SOUT 

^/■SOUT 



/•D«»'s;„ ;r 120 i 



SOUT 140 
-'SOU- 150 






ST'UT i.90 



SO JT 



200 
210 



SCUI __. 
SOUT 220 
SCUT 230 
SOUI 240 
SOUT 250 
SOUT 260 
*/SOUT 270 
*/SOUT 280 
*/SOUT 290 
SOUT 300 
SOUT 310 
SOUT 320 
SOUT 330 
SOUT 340 
SOUT 350 
SOUT 360 
SOUT 370 
SOUT 380 
SOUT 390 
SOUT 400 
SOUT 410 
SOUT 420 
SOUT 430 
SOUT 440 
' . SOUT 450 
SOUT 460 
SOUT 470 
SOUT 480 
SOUT 490 
SOUT 500 
SOUT 510 
SOUT 520 
SOUT 530 
SOUT 540 
SOUT 350 
SOUT 560 
SOUT 570 
SOUT 580 
SOUT 590 
SOUT 600 
SOUT 610 
SOUT 620 
SOUT 630 
SOUT 640 
SOUT 650 
SOUT 660 
SOUT 670 
SOUT 680 
SOUT 690 
SOUT 700 
SOUT 710 
*/SOUT 720 



CANONICAL CORRELATION CANO 
Problem Descri ption 

This prc^ram analyzes the interrelations between 
two sets of variables measured on the same sub- 
jects. These variables are predictors in one set 
and criteria in the other set, but it is irrelevant 
whether the variables in the first set or in the sec- 
ond set are considered as the prediction variables. 
The canonical correlation, which gives the maxi- 
mum correlation between linear functions of the two 
sets of variables, is calculated, x^ is also com- 
puted to test the significance of canonical correlation. 

The sample problem for canonical correlation 
consists of four variables in the first set (left-hand 
side) and three variables in the second set (right- 
hand side) as presented in Table 2. These two sets 
of measurements have been made on 23 subjects. 
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Table 2. Sample Data for Canonical Correlation 

First set Second set 



Observation 



Xi 



X4 



Y2 



Y3 



1 


191 


155 


65 


19 


179 


145 


70 


2 


195 


149 


70 


20 


201 


152 


69 


3 


181 


148 


71 


19 


185 


149 


75 


4 


183 


153 


82 


18 


188 


149 


86 


5 


176 


144 


67 


18 


171 


142 


71 


6 


208 


157 


81 


22 


192 


152 


77 


7 


189 


150 


75 


21 


190 


149 


72 


8 


197 


159 


90 


20 


189 


152 


82 


9 


188 


152 


76 


19 


197 


159 


84 


10 


192 


150 


78 


20 


187 


151 


72 


11 


179 


158 


99 


18 


186 


148 


89 


12 


183 


147 


65 


18 


174 


147 


70 


13 


174 


150 


71 


19 


185 


152 


65 


14 


190 


159 


91 


19 


195 


157 


99 


15 


188 


151 


98 


20 


187 


158 


87 


16 


163 


137 


59 


18 


161 


130 


63 


17 


195 


155 


85 


20 


183 


158 


81 


18 


196 


153 


80 


21 


173 


148 


74 


19 


181 


145 


77 


20 


182 


146 


70 


20 


175 


140 


70 


19 


165 


137 


81 


21 


192 


154 


69 


20 


185 


152 


63 


22 


174 


143 


79 


20 


178 


147 


73 


23 


176 


139 


70 


20 


176 


143 


69 


Program 

















Description 

The canonical correlation program consists of the 
main routine named CANO, a special input routine, 
DAT2, and five subroutines from the Scientific 
Subroutine Package: CORR, CANC, MINV, MGDU, 
and MSDU. 

Capacity 

The capacity of the sample program and the format 
required for data input have been set up as follows: 

1. The number of variables in the first set (that 
is, left-hand variables) must be greater than or 
equal to the number of variables in the second set 
(that is, right-hand variables). 

2. Up to 99,999 observations 

3. Up to ten data cards per observation 

4. (12 F (6, 0)) format for input data cards. 
Therefore, if a problem satisfies the above condi- 
tions, it is not necessary to modify the sample 
program. However, tf the input data cards are 
prepared using a different format, the input format 



in the special input subroutine, DAT2, must be 
modified. The general rules for program modifi- 
cation are described later. 

Input 

Control Card 

One control card is required for each problem and 
is read by the main program, CANO. This card is 
prepared as follows: 



Columns 


Contents 


For Sample 
Problem 




1-6 
7-11 


Problem number (may 
be alphameric) 
Number of observations 


SAMPLE 
00023 


12-13 


Number of variables in 


04 


14-15 


the first set (that is, 
left-hand variables)* 
Number of variables in 


03 


16-17 


the second set (that is, 
right-hand variables) 
Number of data cards 
per observation 


01 



Leading zeros do not have to be keypunched, but 
must be right-justified within the field. 

Data Cards 

Since input data are read into the computer one ob- 
servation at a time, each row of data in Table 2 is 
keypunched on a separate card using the format 
(12 F (6, 0)). This format assumes twelve 6-column 
fields per card. 

Deck Setup 

Deck setup is shown in Figure 20. 



*The number of variables in the first set must be 
greater than or equal to the number of variables 
in the second set. 
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Lost problem 



Second problem 



First- problem 




Procedures and main program 



Figure 20. 



Sample 



SA^'PLECC 
191 

is; 

181 
183 
176 

2ce 

18S 
1^7 

ise 

192 
179 
183 
ITi 
19C 
186 
1*3 
195 
196 
IBI 
175 
192 
n't 
176 



C23C403I 
155 

lis 
lie 

153 

11A 
157 
15C 
159 
152 
15C 
15t 
l<i7 
15C 
159 
151 
127 
155 
153 
145 

lie 

143 



179 


145 


iOl 


152 


185 


149 


188 


149 


171 


142 


192 


152 


19C 


149 


189 


152 


1^7 


159 


187 


151 


l«t 


148 


174 


147 


185 


152 


195 


157 


18? 


158 


161 


130 


183 


158 


i/3 


148 


182 


146 


165 


137 


185 


152 


178 


147 


176 


143 

















40 


86 




71 


60 




70 








90 








110 








130 








150 


87 


160 


63 


170 




180 




190 








210 






73 


230 




240 







The listii^ of input cards for the sample problem is 
shown in Figure 21. 



Figure 21. 



Output 

Description 

The output of the sample program for canonical 
correlation includes: 

1. Means 

2. Standard deviations 

3. Correlation coefficients 

4. Eigenvalues and corresponding canonical 
correlation 

5. Lambda 

6. Chi-square for left- and right-hand variables. 

Sample 

The output listing for the sample problem is shown 
in Figure 22. 



CANONICAL COR^e 
■JO. CF '?9SERV 
NO. OF LcFT H 
NO. OF RIGHT 






MPLE 
23 
4 
S 3 










ATIONS 

ANO VARIAPLES 

HAND VARIABLE 




MEANS 

1P5. 47626 


149 


913C4 


76 


86955 


19 


.47826 


STANOAPO DEVIATIONS 

K.1C342 6 


31673 


IC 


463 3 8 


1 


.'•8165 


CQOO 


LATION COEFFlCieNTS 














RON 


1 
l.OCCCC 


0.74852 




C.37C?? 




C.664'-l 


r 


62291 


ROW 


2 
0.74852 


l.CCOCC 




0.63252 




C. 22590 


C 


66811 


ROW 


3 
C. 37082 


C. 63252 




l.CCOCC 




C. 20657 





47394 


ROW 


4 
C. 66441 


0.2259C 




CZOfc-j? 




l.COCCC 


c 


32870 


ROW 


5 
0.622';i 


0.668U 




C. 47394 




C.32&7C 


1 


COOOO 


ROW 


6 
0.66C30 


0.72760 




C. 60169 




C. 34863 


c 


82555 


ROW 


7 
C.246P3 


0.52194 




0.79634 




-0. K733 





39258 



183.CCCC0 149. B2608 

9.84424 6.73965 



0.66C80 0.24633 

0.72730 0.5319<^ 



0.6C169 



0.79684 



C.3.i863 -0.1C733 

0.82555 0.3925P 

l.CCOCC 0.47657 

0.47657 l.COi'O'- 



'5. 73912 
9.05647 



Figure 22. 
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NUMSER OF 
EIGENVALUcS 

REMOVeO 



LARGEST 
EIGENVALUE 
REMAINING 
0.798S0 

0.00767 



CCPRESPGNOING 

CANONICAL 

CCCOELATICN 

C. 89376 

C. 6^738 

C.C876C 



-.11593 

0.57644 
0.992 3 3 



40.93277 

10.46676 
0.14636 



CANONICAL CORRELATION 



COEFFiCIENTS FIR LEFT HAND VARIABLES 

0.6631C -C.16C59 1.C5822 



COEFFICIENTS FOR RIGHT HAND VARIABLES 

-0.02133 C.440«C 0.89730 



CANONICAL CHRRELATION C. 64738 

COEFFICIENTS FDP LEFT HAND VARIABLES 

0.09454 -0.83915 0.663C9 

COEFFICIENTS FOR RIGHT HAND VARIABLES 

-0.43841 -0.55503 0.70692 



CANONICAL CCPRELATION 



COEFFICIENTS FOP LEFT HAND VARIABLES 

0.0 2681 C.36C5 5 -0.288 27 



COEFFICIENTS FOR RIGHT HAND VARIABLES 

C. 7032 5 -0.70384 0.10028 



END OF SAMPLE PROGRAM 



Figure 22. (Continued) 



Program Modifications 



Timing 



Input data in a different format can also be handled 
by providing a specific format statement. In order 
to familiarize the user with program modifications, 
the following general rule is supplied in terms of the 
sample problem: 

1. Changes in the input format statement of the 
special input routine, DAT2. 

Since sample data are either two- or three-digit 
numbers, rather than using six-column fields as in 
the sample problem, each row of data might have 
been keypimched in seven 3-column fields; if so, the 
format would be chained to (7 F (3, 0)). Note that 
the current input format statement will allow a max- 
imum of twelve variables per card. 

The special input routine is normally written 
by the user to handle different formats for different 
problems. The user may modify this subroutine to 
perform testing of input data, transformation of 
data, and so on. 

2. If there is more than one card per row of data, 
the value of the card count indicator (NCARD), which 
appears in columns 16-17 of the control card, must 
be changed to agree with the number of data cards 
per row. 

Operating Instructions 

The sample program for canonical correlation is a 
standard PL/I program. Special operatii^ instruc- 
tions are not required. Data set SYSIN is used for 
input; data set SYSPRINT, for output. 



The execution of this sample program on a System/ 
360 Model 40, usii^ an IBM 2540 Card Reader as 
input and an IBM 1403, Model Nl, as output, is 17 
seconds. 



*«*«**•««***«**««***«***«*«****««******* 



CANO 10 

:«»s»****««***/CANO 20 

•/CANO 30 

>* TO READ THE PROBLEM PARAMETER CARD FOR A CANONICAL COBRE- */CANO 40 
/♦ LATION, CALL TWO PROCEDURES TO CALCULATE SIMPLE CORRELATIONS, '/CANO 50 
/* CANONICAL CORRELATIONS, CHI-SQUARES, DEGREES OF FREEDOM FOR */CAND 60 
/• CHI-SQUARES, AND COEFFICIENTS FOR LEFT AND RIGHT HAND */CANO 70 
/» VARIABLES, NAMELY CANONICAL VARIATfcS, AND PRINT THE RESULTS. */CANO 80 
/, */CANO 90 

/*««*»«4*«**««*«««*****«*«****««********«***«*****««******************/CAN0 100 
PROCEDURE OPTIONS tMAIN),. 
DECLARE 

IIiIO.J,H,MM,MP,M0,N,Nl) 

FIXED BINARY, 

CH CHARACTER (801, 

ERROR EXTERNAL CHARACTER ID* 

(NCARD, NV) EXTERNAL, 

PR CHARACTER (6>t* 



ON ENOFILE I SYSIN) GO TO EXIT,. 
SIOO.. 

GET EDIT ICH) (A(80)),. 

GET STRING (CHI EDIT (PR, N, MP, MQ, NCARD) (A(6),F(5),3 F(2)»,. 



PR PROBLEM NUMBER (MAY BE ALPHAMERIC) 

N NUMBER OF OBSERVATIONS 

MP NUMBER OF LEFT HAND VARIABLES 

MQ NUMBER OF RIGHT HAND VARIABLES 

NCARD. ...NUMBER OF CARDS PER OBSERVATION 



,PR, 



OF OBSERVATIONS' 



A,At6), 
,F(5>, 



PUT EDIT ('CANONICAL CORRELATION.... 

•NO. OF LEFT HAND VARI ABLES • ,MP, 

'NO. OF RIGHT HAND VARIABLES' ,MQ) (PAGE,COLUMN( 10 ) 

SKIP(l),C0LUMN(12».A,X(8),F(4),SKIP(l).C0LUMN(12», 

SKIP(1},C0LUMN(12>,A,F(4)),. 
H =MP-fMQ,. 
NCARD-NCARD*80,. 
NV =0,. 
STRT.. 

BEGIN,. 
DECLARE 

(COEFL(MP,MQ).COEFR(MO,HQ).R(M,M),RX(M,M),CHISQIMQ),CANR(MQ) 

$TOtH),XBAR(M},X(l,l),6IH>,ROOTS(M0),WLAM(HQ)) 

BINARY FLOAT, /*SINGLE PRECISION VERSION 

/* BINARY FLOAT (531, /•DOUBLE PRECISION VERSION 

NOFIMQ) FIXED BINARY,. 
10 =0.. 
X =0.0,, 

CALL CORR IN,M,IO,X,XBAR,STD,RX,R,B),. 
IF ERRCW NE '0* 
THEN DO,. 

PUT EDIT ('IN ROUTINE CORR ERROR CODE = ', ERROR) 
tSKlP(2),COLUMN110},A,A(l}),. 

GO TO 5100,. 

END,. 



PRINT MEANS, STANDARD DEVIATIONS, 
COEFFICIENTS OF ALL VARIABLES 



AND CORRELATION 



CANO 110 

CANO 120 

CANO 130 

CANO 140 

CANO 150 

CANO 160 

CANO 170 

CANO 180 

♦/CANO 190 

CANO 200 

CANO 210 

CANO 220 

CANO 230 

*/CANO 240 

*/CAN0 250 

*/CANO 260 

*/CANO 270 

*/CANO 280 

*/CANO 290 

*/CANO 300 

CANO 310 

CANO 320 

CANO 330 

CANO 340 

CANO 350 

CANO 360 

CANO 370 

CANO 380 

CANO 390 

CANO 400 

CANO 410 

, CANO 420 

CANO 430 

/*S*/CANO 440 

/*D*/CANO 450 

CANO 460 

CANO 470 

CANO 480 

CANO 490 

CANO 500 

CANO 510 

CANO 520 

CANO 530 

CANO 540 

CANO 550 

»/CANO 560 

*/CANO 570 

♦/CANO 580 
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PUT EDIT ('MEANS') IRIFMI)),. 
FMl.. 

FORMAT (SKIP(2),C0LUMNU0),A),. 

PUT EDIT ({X6AR(I} DO 1= I TO M) ) (R(FH2»),. 

FORMAT (SK1P,C0LUMN(10I»7 F(15,5))». 

PUT EDIT C'STANOARO DEVIATIONSM <R(FM1)),. 

PUT EDIT ((STOU) DO 1= 1 TO M} ) tRfFM2>t,. 

PUT EDIT {'CORRELATION COEFFICIENTS') ( SKIP ( 2 J,COLUHN( 10 I , A> . . 

DO I = I TO M,. 

PUT EDIT CROW, 11 (SKI P(2) .COLUMN! 10) , A, FU)) , . 

PUT EDIT KRd.Jl DO J= 1 TO M)) ( SKIP, COLUMN! 10) ,9 F(12,5)) 

CALL CANC (N, MP, MQ,R, ROOTS, HLAM,CANR,CHIS0,NOF,COEFR,CGEFL).. 
IF ERROR NE '0' . u».. 

THEN DO,. 

PUT EDIT ('IN ROUTINE CANC ERROR CODE - '.ERROR) 
{SKIP(2).C0LUMN(10),A,A(I)),. 

IF ERROR = 'I' 

THEN 60 TO SlOO,. 

END,. 



PRINT EIGENVALUES, CANONICAL CORRELATIONS, LA 
CHI-SQUARES DEGREES OF FREEDOM 



I BOA, 



*/CANO 590 
CANO 600 
CANO 610 
CANO 620 
CANO 630 
CANO 640 
CANO 650 
CANO 660 
CANO 670 
CANO 680 
CANO 690 
CANO 700 
,. CANO 710 
CANO 720 
CANO 730 
CANO 740 
CANO T50 
CANO 760, 
CANO 770 
CANO 780 
CANO 790 
CANO 800 
•/CANO 810 
•/CANO 820 
•/CANO 830 
•/CANO 840 
CANO 850 
CANO 860 
CANO 870 
CANO 

CANO 890 

CANO 900 

CANO 910 

CANO 920 

•/CANO 930 

♦/CANO 940 

•/CANO 950 

CANO 960 

CANO 970 

CANO 980 

CANO 990 

CANO 1000 

CANOIOIO 

CAN01020 

CAN01030 

CANO104O 

♦/CAN01050 

•/CAN01060 

001 = 110 MM.. ^TAmWai 

PUT EDIT ('CANONICAL CORRELATI ON' ,CANR( I) ) (SK IP(5) .COLUMN! 10), CANai090 

PUT EDIT ('COEFFICIENTS FOR LEFT HAND VARIABLES') (R(FMl)).. CANOlllO 

PUT EDIT ((COEFLIJ.I) DO J= 1 TO HP)) (R(FH2)).. CAN01120 

PUT EDIT ('COEFFICIENTS FOR RIGHT HAND VARIABLES') (R(FMl)),. CAN01130 

O..T cn.T .,r^r^„,. .. „„ ._ . To„Q,, |R(FM2)).. CANail40 

CAN01150 
CAN01160 
CAN01170 

PUT FILE (SYSPRLNT) EDIT ('END OF SAMPLE PROGRAM') CANmi90 

ISKIP(5),C0LUMN(10),A).. CAN01200 

/•END OF PROCEDURE CANO */CAN01210 



PUT EDIT ('NUMBER OF '.' LARGEST ', 'CORRESPONDING' , 'DEGREES' . 
•EIGENVALUES', 'EIGENVALUE'. 'CANONICAL', 'LAMBDA', 
'CHI-SQUARE', 'OF*, 'REMOVED', 'RE MAINING*. 'CORRELATION', 
•FREEDOM') (SKIP{4),C0LUMN(13),A,X(5),A,X(7),A,XI31),A, 
SKIP,C0LUMN(11).A,X(5).A,X(7),A,X(7),A,XI5),A,X(7),A. 
SKIP,C0LUMN(13),A,X(7),A,X(7).A,X(32),A),, 
00 I = 1 TO MQ,. 
Nl =1-1.. 

TEST WHETHER EIGENVALUE IS GREATER THAN ZERO 

MM =N1,, 

IF ROOTS(I) GT 0.0 

THEN DO.. 

PUT EDIT (N1,R0GTS(I),CANR(I),MLAM(1).CHISQ(I).NDF1I)I 
($KIP(l).C0LUMNa0).F(7).F(19.5),F(16,5), 
2 F(14,5).X(5),F<5)).. 
MM =MQ,. 
END,. 



END. 

PRINT CANONICAL CORRELATION 



PUT EDIT ((COEFR(J.n DO 
END.. 
END,. 

GO TO SlOO.. 
EXIT., 



END, 



_1 



* TO P.EflD FLOATING POINT DATA, ONE OBSERVATION AT A TIME. 

* OAia MAY BE SAVED ON fl DATA SET. 

PROCEDURE (w,D),. 
DECLARE 

XDATA FILE STREAM ENVIRONMENT (CONSECUTIVE V(20C0,200)), 

(NCARO.NV) EXTERNAL. 
CH CHAfiACTEP(NCARO) , 
( I ,M,MM) FIXED BINARY, 
D(*) FLCAT BINARY,. 

ON ENOFILE ( SYSINl 

GO TO EXIT,. 

GET EDIT (CM) (AINCARO)),. 

MM =CEIL(«/I2) ,. 

GET STRING (CHI EDIT ((D(I) DO 1= I TO M)) 

((«1M)< t 12)F(6,0),X(8))),. 
IF NV= 1 

THEN PUT FILE (XDATAl EDIT ((0(H 00 1= 1 TO H)) ( (MIF (6, C) ) , . 
REVEST ENDFILE ( SYSIN) ,. 
RETURN. . 
XIT.. 

PUT FILE (SYSPftlNTl EDIT ('ERROR INSUFFICIENT DATA') 

( SKIPl I) .COLUMN! 10) ,A) , . 
STOP,. 
END,. /*ENO OF PROCEDURE DAT2 



DAT2 


10 


**/DAT2 


20 


•/DAT2 


30 


*/DAT2 


40 


*/DAT2 


50 


*/DAT2 


60 


**/0AT2 


70 


DAT2 


90 


DAT2 


90 


0AT2 


100 


0AT2 


110 


oaT2 


120 


0AT2 


130 


DAT2 


140 


*/0AT2 


150 


DAT2 


160 


DAT2 


170 


0AT2 


180 


DAT2 


190 


0AT2 


200 


DAT2 


210 


0AT2 


??0 


0AT2 


230 


[)AT2 


240 


0AT2 


2 50 


0AT2 


260 


DAT2 


270 


DAT2 


280 


DAT2 


290 


*/DAT2 


300 



ANALYSIS OF VARIANCE ANOV 



Problem Description 



designs can be derived by first reducii^ them to 
factorial designs, and then pooling certain com- 
ponents of the analysis-of-variance table. 

Consider a three-factor factorial experiment in 
a randomized complete block design, as presented 
in Table 3. In this experiment factor A has four 
levels, factors B and C have three levels, and the 
entire experiment is replicated twice. The repli- 
cates are completely unrelated and do not constitute 
a factor. 



Table 3. Sample Data for Analysis of Variance 



Replicate 




bl 


bz 


b3 


(Block) 


ai 


82 


^3 


^4 


a. 


32 aj 


a4 


aj 


aa 


a, 


^4 




j'c, 


3 


10 


9 


8 


24 


8 9 


3 


2 


8 


9 


8 


r, . . . . 


r 


4 


12 


3 


9 


22 


7 16 


2 


2 


2 


7 


2 




(=3 


5 


10 


5 


8 


23 


9 17 


3 


2 


8 


6 


3 




(=. 


2 


14 


9 


13 


29 


16 11 


3 


2 


7 


5 


3 


r,.... 


u 


7 


11 


5 


8 


28 


18 10 


6 


6 


6 


5 


9 




u 


9 


10 


27 


8 


28 


16 11 


7 


8 


9 


8 


15 



Nevertheless, for the purpose of this program, a 
four-factor experiment (with factors A, B, C, and 
R) is assumed. Thus, each element of the data in 
Table 3 may be represented in the form: 

abcr where a = 1,2,3,4 

b = 1,2,3 

c = 1,2,3 

r = 1,2 

The general principle of the analysis-of-variance 
procedure used in the program is first to perform a 
formal factorial analysis and then to pool certain 
components in accordance with summary instructions 
that specifically apply to the particular design. The 
summary instructions for four different designs are 
presented in the output section. 



An analysis of variance is performed for a factorial Program 

design by use of three special operators suggested 

by H. O. Hartley. * The analysis of many other Description 



*H. O. Hartley, "Analysis of Variance" in MaQie- 
matical Methods for Digital Computers , edited by 
A. Ralston and H. Wilf, John Wiley and Sons, 1962, 
Chapter 20. 



The analysis of variance program consists of the 
main routine, named ANOV, a special input routine 
DATS, and one subroutine from the Scientific Sub- 
routine Package: AVAR. 
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Capacity 



Data Cards 



The capacity of the sample program and the format 
required for data input have been set up as follows: 

1. Up to 14 factors 

2. The total number of data points is limited 
only by the size of available core storage used for 
input. 

3. (12 F(6, 0)) format for input data cards. There- 
f<^re, if a problem satisfies the above conditions, it 
is not necessary to modify the sample program. 

* Cowever, if the input data cards are prepared using 
a different format, the input format statement must 
be modified. The general rules for program modi- 
fications are described later. 

Input 

Control Cards 

Two control cards are required for each problem 
and are read by the main program, ANOV. 

The first card is prepared as follows: 
Columns Contents 



For Sample 
Problem 



1-6 



7-8 



Problem number (may be SAMPLE 

alphameric) 

Number of factors 04 



The second card is prepared as follows: 
Columns Contents 



For Sample 
Problem 



1 
2-5 



7-10 



Label for the first factor A 

Number of levels for the 0004 

first factor 

Label for the second B 

factor 

Number of levels for the 0003 

second factor 
11 Label for the third factor C 

12-15 Number of levels for the 0003 

third factor 
16 Label for the fourth factor R 

17-20 Number of levels for the 0002 

fourth factor 



Data is keypunched in the following order: X , 

^2111' ^3111' "^1211' ^2211' ^3211 ^4332. 

In other words, the leftmost subscript (namely, the 
first factor) is chained first; then the second, third, 
and fourth subscripts. In the sample problem, the 
first subscript corresponds to factor A; the second, 
third, and fourth subscripts, to factors B, C, and 
R. Since the number of data fields per card is 
twelve, implied by the format (12 F(6,0)), each row 
in Table 3 is keypunched on a separate card. 

Deck Setup 

Deck setup is shown in Figure 23. 



Last problem 



Second problem 




First problem 



Procedures and main program 



Figure 23. 



Sample 



The listing of input cards for the sample problem is 
shown in Figure 24. 



66 Label of the fourteenth 

factor 
67-70 Number of levels of the 

fourteenth factor 



' S*^pl.£ <. 
























10 


i '.e 


3C 


2R 2 
























10 


9 


8 


24 


8 




3 


2 


8 


9 


8 


30 


4 


\l 


3 


9 


22 


7 




2 


2 


2 


7 


2 


AO 


5 


IC 


5 


8 


23 


9 




3 


2 


8 


6 


3 


50 


2 


14 


9 


13 


2? 


16 




3 


2 


7 


5 


3 


60 


7 


11 


5 


fl 


2t 


18 




6 


6 


6 


5 


9 


70 


^ 


IC 


27 


8 


26 


16 




7 


8 


9 


8 


15 


fiO 



Leadii^ zeros do not have to be keypunched. 



Figure 24. 
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Output 

Description 

The output of the sample analysis-of-variance pro- 
gram includes the numbers of levels of factors as 
input, the mean of all data, and the table of analysis 
of variance. In order to complete the analysis of 
variance properly, however, certain components in 
the table may need to be pooled. This is accom- 
plished by means of summary instructions that 
specifically apply to the particular experiment* 
Some of these are presented in Table 4, 

As mentioned earlier, the sample problem is a 
randomized complete block design with three factors 
replicated twice. Therefore, it is necessary to pool 
certain components in the table of analysis of vari- 
ance shown in Figure 25. Specifically, the compo- 
nents AR, BR, ABR, CR, ACR, BCR, and ABCR 
are combined into one value, called the error term. 
The result is indicated in Figure 25. Since these 
data are purely hypothetical, interpretations of the 
various effects are not made. 



ANALYSIS OF VARIANCE SAMPLE 



LEVELS OF FACTORS 



GRAND MEAN 



SOURCE OF 
VARIATION 



ACR 
8CR 
A8CR 



END DF SAMPLE PROGRAM 



SUMS OF 
SQUARES 



229.04166 

722.69434 

1382.C8325 

55.11110 

42.00000 

13.13889 

140.75000 

141.68054 

18,81944 

6.02778 

176.97221 

40.77777 

50.55554 

62.63889 

151.C2777 

3233.31763 



MEAN 
S(HJARES 



76.34721 

361.34717 

230.34720 

27.55554 

7.00000 

3.28472 

11.72917 

141.68054 

6.27315 

3.01389 

29.49536 

20.38889 

8.42592 

15.65972 

12.58565 



Figure 25. 



Program Modifications 



Table 4, Instructions to Summarize Components 
of Analysis of Variance 









Randomized 






Single Classification 


Two-way Classificatio 


Complete Block 


Split Plot 




with Replicates 


witli Cell Replicates 


with Two Factors 




(Input) 










Faclor No. 1 


Groups - A 


Rows = A 


Factor 1 = A 


Main treatment - A 


2 


Replicates = R 


Columns - B 


Factor 2 = B 


Suhtreatment ^ B 


3 




Replicates = R 


Blocks = R 


Blocks = R 


(Oulpul) 










Sums of squares 


A 


A 


A 


A 




R 


B 


B 


B 




AR 


AB 


AB 


AB 






R 


R 


R 






AR 


AR 


AR 






BR 


BR 


BR 






ABR 


ABR 


ABR 


Summary 


Error = R + (AR) 


Error = R + (AR) 


Error = (AR)+ (BR) 


Error = (BR)+(ABR) 


instruction 




«BR)+(ABR) 


+ (ABR) 


(b) 


Analysis of 


Groups A 


Rows A 


Factor J A 


Main treatment A 


variance 


Error 


Columns B 


Factor 2 8 


Blocks R 






Interaction AB 


Interaction AB 


Error (a) AR 






Error 


Blocks R 
Error 


Sublreatment B 
Interaction AB 
Error (b) 



Input data in a different format can also be handled 
by providing a different format statement. In order 
to familiarize the user with the program modifica- 
tions, the following general rule is supplied in terms 
of the sample problem: 

Only the format statement and the variable per card 
count indicator for input data may be chained. Since 
sample data are eitiier one- or two-digit numbers, 
rather than using a six-colunm field, as in the 
sample problem, each row of data might have been 
keypunched in a two-column field; if so, the format 
is changed to (12 F(2, 0)). This format assumes 
twelve 2-column fields per card, beginning in 
column 1. 

Operating Instructions 

The sample analysis of variance program is a stan- 
dard PL/I program. Special operating instructions 
are not required. Data set SYSIN is used for input; 
data set SYSPRINT, for output. 



Timing 



Sample 

The output listing for the sample problem is shown 
in Figure 25. 



The execution of this sample prc^ram on a System/ 
360 Model 40, usii^ an IBM 2540 Card Reader as 
input and an IBM 1403, Model Nl, as output, is 11 
seconds. 
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***« 



t:*i***tt***^* 



«*«:**** •«: 



««** 



TO READ THE PROBLEM PflRAMETEF CARD FOR ANALYSIS OF VARIANCE 
CALL THE PROCEDURES FPR THE CALCULATION CF SUMS Qf SQUARES, 
DEGREES CF FREEDO"^ AND HEA'^ S'^LIAPE, AND PRINT FACTO' LEVELS 
GRAND MEAN AND ANALYSIS OF Vfi'IANCE TABLE. 



PFOCEOUFF OPTIONS (fAINt.. 
OeCLARF 

(I , J,K,L,M,MH,N» 

FIXEO BINARY, 

ERROR EXTERNAL CHARACTERd). 

PRl CHARACTER (6) , 

CH CHARACTER ( 8C) ,. 
/* 

ON ENOFILE (SYSIN) GO TO EXIT,. 
SlCC. 

GET EDIT (CH) 1A( SCI) , . 

GET STRING (CH) EDIT IPRl.K) IAI6»,F(2I)t 



****: 



Pfil. 



.POOBLEM NUMBER (MAY BE ALPHAMERIC! 
.NUMBER OF FACTORS 



N =( 2*«K)-l, , 

ONE.. 

BEGIN,. 
DECLARE 

(SUMSO(N) ,SMEAN(N) .GMEAN.SUNI 

FLOAT BINARY, /^SINGLE PRECISION VERSION 

/* FLOAT BI^^ARY (531.. /^DOUBLE PRECISION VERSION 

(LEVEL(K),NDF(N),ISTEP(K1) PIN'RY FIXEO, 

(HEAD(K),FMT(KJ ) CHARACTER (1),. 
GET EDIT ICH) (Al 80)),. 
GET STRING (CH) EOIT ( ( HE A0( I ) , LE VEL ( I ) DO 1= I TO K)) 

I 141A(1 ) ,F(4) )) , . 



HEAD. ..FACTOR LEVELS 
LEVEL. .LEVELS OF FACTORS 



/* 



PUT EDIT ("ANALYSIS OF VARIANCE ', PRl t ' LEVELS OF FACTORS') 

(PAGE.SKIPtA) , COLUMN! 101 ,fi,A(6) ,SK I PU ) .COLUMN UC ) , A) . . 
PUT EOIT ( (HEADII) ,LEVEL(n DO 1= 1 TO K)! 

(SKIP,C0LUMN(13),A(11 ,X( 7). F (*)),. 
M = POOD (LEVEL),. 

MM = PROD (LEVEL-H) ,. 
TWO. . 

BEGIN,. 
DECLARE 

X(MM) 

FLOAT BINARY.. /*SINGL£ PRECISION VERSION 

/« FLOAT BINARY (53),, /*DOUBLE PRECISION VERSION 



READ IN ALL INPUT DATA 

CALL 0AT3 (M,XI,. 

CALL AVAR ( K, LEVEL ,M, X.GME AN, SUMSCNOF .SMEANl , . 

IF ERROR NE '0' 

THEN DO,. 

PUT EOIT IMN ROUTINE AVAR ERROR CODE = •, ERROR! (SKIP(2 
COLUMN(10).A,A(1!),. 

GO TO SICO,. 

END,. 

PRINT THE GRAND MEAN 
PUT EDIT ('GRAND MEAN'.GMEAN) 1 SK IP (61 ,COLU»N( 10) , A, F( 2C, 5) ) , 
PRINT ANALYSIS OF VARIANCE TABLE 

PUT EDIT ('SOURCE OF' , ' SUMS OF', 'DEGREES OF', 'MEAN', 
•VARIATION' , • SQUARE S'.'FPEEDCM' ,■ SQUARES' 1 
(SK1P(6),C0LUMN(101,A,X(18),A,X(IC).A,X(9).A,SK1P, 
COLUHN( 10)>A.X(18).A,X(11>,A.X(10I.A1,. 

PUT SKIP( 21,. 



isTep= 0, 




ISTEP11)= 


1>. 


DO 1 


= 1 TO N,. 


L 


= 0,. 




00 J = 1 TO K, 




FMT(J)=' ',. 




IF ISTEP(J) NE 




THEN DO,. 



INITIALIZE FOR PRINT OUT 



L =L*I,. 
FMT(L)=HEAO(J),. 
END,. 
END,. 
PUT EOIT ((FMTILl DO L= 1 TV K ) ,SUMSQ( I ) ,NOF( I ) , SMEANd) ) 
(SKIP,COLUMN{10),(K)A(1) , C0LUHN(23) , F ( 2C, 5) , X( 10) , 
F(61,F(20,5)),. 
IF I LT 



THEN DO,. 



1 TO K,. 
IF ISTEP(J1= 
THEN 00,. 

ISTEP(Jl=l,. 
GO TO S160,, 
END,. 
ISTEP( J1=0,. 
END.. 
END. . 
160.. 

END, . 
M =M- 1 , . 
SUN =SUM( SUMSOl .. 
PUT EDIT ( 'TOTAL ', SUN, M) ( SKI P{2 t , COLUMN! 10 1 , A, X( 10) , Fl 18, 5 1 , 

X(1C1,F(61),. 
END.. 
END, . 

GO TO SICO,. 
XIT.. 

PUT FILE (SYSPRINT) EOIT ('END OF SAMPLE PROGRAM') 

{ SKIP! 5), COLUMN (10) ,A) ,. 
END,. /*END OF PROCEDURE ANOV 



ANOV IC 

"•/A'jrv 20 

*/aNGV 30 

*/ANCV AC 

*/AMnv 5C 

«/«NOV 60 

*/ANOV 7C 

"/ANOV 80 

;*»/aNOV 90 

ANOV IOC 

ANOV no 

ANOV 120 

ANCV 130 

ANOV lAC 

ANOV 150 

ANOV 160 

*/ANDV 170 

ANOV IBC 

ANCV 190 

ANCV 200 

ANOV 21C 

*/ANCV 220 

*/flNOV 230 

*/ANOV 240 

*/iMOV 250 

ANOV 260 

ANOV 27C 

AMnv 280 

ANCV 290 

ANOV 30C 

l'S*/aNCV 3ir 

»D*/ANOV 320 

ANOV 33C 

ANOV 340 

ANOV 350 

ANOV 36C 

ANOV 370 

*/ANOV 380 

^/ANOV 390 

*/ANOV 400 

*/ANOV 410 

ANOV 420 

ANOV 430 

ANOV 440 

ANCV 450 

ANOV 46C 

ANOV 47C 

ANOV 480 

ANOV 49C 

ANOV 500 

ANOV 510 

*S*/ANOV 520 

*D*/ANCV 530 

ANOV 54C 

*/ANOV 550 

*/ANCV 560 

*/ANOV 57C 

ANOV 58G 

ANCV 5'50 

ANOV 600 

iNOV 61C 

ANOV 620 

ANOV 630 

ANOV 640 

ANOV 650 

*/ANOV 660 

*/ANOV 670 

*/ANOV 68C 

ANOV 690 

*/ANOV 700 

*/ANOV 710 

*/ANOV 720 

ANOV 730 

ANOV 740 

6N0V 750 

ANOV 760 

A\iOV 77C 

«/ANOV 780 

ANOV 790 

ANOV 80C 

ANOV 810 

ANOV 820 

ANOV 830 

ANOV 840 

ANOV 850 

ANOV 660 

ANOV 870 

ANOV 880 

ANOV B9C 

ANOV 900 

ANOV 910 

ANOV 920 

ANOV 930 

ANOV 940 

ANOV 950 

ANOV 960 

ANOV 970 

ANOV 980 

ANOV 990 

ANOVIOOO 

ANOVIOIO 

ANOV1020 

ANOV1030 

AfgOV1040 

ANOV1050 

AN0V1060 

ANOV1070 

ANOV1080 

ANOV1090 

ANGVllOO 

ANOVIUO 

AN0V1120 

AN0V113C 

AN0V1140 

AN0V115O 

*/AN0V1160 



TO READ A VECTOR OF FLOATING POINT DATA. 



:»*******»***■ 



*#«»»*** *•**»♦!**»*»*!*««**«« 



PROCEDURE (M.Dl,. 
DECLARE 

CH CHARACTER (80) , 

( I,M,N,N1,N21 

FIXED BINARY, 

0(M) FLOAT BINARY,. 

N EQUAL THE NUMBER OF DATA POINTS PER 80 COLUMNS OF A 

CARD. 

ON ENDFILE ( SYSIN) 
GO TO EXIT,. 



Nl 

N2 



= 1.. 



SIO.. 

IF M LE N2 

THEN N2 =M,. 

GET EDIT (CH) (A(30)),. 

GET STRING (CH) EDIT ((0(1) DO T= Nl TO N21) ( ( N) F( 6,0! 1 . . 

Nl =N2tl,. 

IF Nl LE M 

THEN 00, . 

N2 =N2*N,. 

GO TO SIC. 

END,. 
REVERT ENDFILE (SYSIN),, 
RETURN, . 
EXIT.. 

PUT FILE (SYSPRINT! EOIT ('ERROR INSUFFICIENT DATA') 

(SK10(1),COLUMN(10) ,A),. 
STOP,. 
END,. /*END OF PROCEDURE 0AT3 



DAT3 


10 


****«*»/0AT3 


20 


*/0AT3 


30 


•/0AT3 


40 


•/0AT3 


50 


*******/0AT3 


60 


0AT3 


70 


0AT3 


80 


DAT3 


90 


DAT3 


100 


0AT3 


110 


0AT3 


120 


♦/DAT3 


130 


ATA •/0AT3 


140 


*/0AT3 


150 


•/DAT3 


160 


0AT3 


17C 


0AT3 


180 


DATS 


190 


DAT3 


?00 


DAT3 


210 


DAT3 


220 


DAT3 


230 


DAT3 


?40 


0AT3 


?50 


0AT3 


260 


0AT3 


270 


0AT3 


280 


DAT3 


290 


DAT3 


300 


0AT3 


310 


DAT3 


320 


DAT3 


330 


DAT3 


340 


DAT3 


350 


0AT3 


360 


DAT3 


370 


0AT3 


380 


»/DAT3 


390 



DISCRIMINANT ANALYSIS MDSC 

Problem Description 

A set of linear functions is calculated from data on 
many groups for the purpose of classifyii^ new 
individuals into one of several groups. The classi- 
fication of an individual into a group is performed 
by evaluatir^ each of the calculated linear functions, 
then finding the group for which the associated prob- 
ability is largest. 

The sample problem for discriminant analysis 
consists of four groups of observations, as presented 
in Table 5. The number of observations in the first 
group is eight, the second group seven, the tiiird 
group seven, and the fourth group e^ht. The number 
of variables in all groups is six. 

Program 

Description 

The discriminant analysis consists of the main pro- 
gram MDSC, a special input routine DAT2, and 
three subroutines from the Scientific Subroutine 
Package: DMTX, MINV, DSCR. 
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Table 5. Sample Data for Discriminant Analysis 



Observation 



Group 1 



Group 2 



Group 3 



Group 4 



3 
4 
9 

16 
5 

17 
2 
7 



11 
8 
1 

7 
7 

7 



10 

12 

3 

2 

10 

3 

10 

10 



10 

7 

10 



9 
10 



27 
8 
2 



3 


11 


9 


9 


4 


10 


4 


13 


10 


8 


5 


16 


6 


9 


10 


8 


10 


5 


17 


3 


2 


3 


10 


8 


4 


12 


3 


9 


3 


2 


15 


2 


2 


9 


10 


26 


8 


9 


2 


7 


8 


6 


7 


10 


5 



X. 


Xs 


X. 


8 


24 


8 


8 


22 


7 


8 


9 


8 


2 


7 


2 


8 


23 


9 


8 


6 


3 


8 


29 


16 


8 


28 


18 


8 


28 


16 


9 


8 


15 


8 


27 


16 


14 


14 


13 


6 


18 


2 


2 


19 


9 


8 


27 


17 



15 
7 
7 

16 
5 



20 


10 


9 


9 


21 


15 


16 


7 


23 


11 


27 


16 


6 


3 


23 


8 


23 


7 


21 


7 


7 


2 


27 


16 


26 


16 


18 


2 


26 


16 



Input 

Control Cards 

Two control cards are required for each problem 
and are read by the main program, MDSC. 
The first card is prepared as follows: 



Columns 


Contents 


For Sample 






Problem 


1-6 


Problem number (may 
be alphameric) 


SAMPLE 


7-8 


Number of groups 
fereater than 1) 


04 


9-10 


Number of variables 


06 


11-12 


Number of cards per 
observation 


01 



The second card is prepared as follows: 



Columns 


Contents 


For Sample 
Problem 


1-3 


Number of obseirvations 
in the first group 


08 


4-6 


Number of observations 
in the second group 


07 


7-9 


Number of observations 
in the third group 


08 


10-12 


Number of observations 
in the fourth group 





Capacity 

The capacity of the sample program and the format 
required for data input have been set up as follows: 

1. Up to 25 groups 

2. The number of variables and the number of 
observations depend on the size of core available 
for input. 

3. (12 F(6, 0)) format for input data. Therefore, 
if a problem satisfies the above conditions, it is 
not necessary to modify the sample program. How- 
ever, if input data cards are prepared using a dif- 
ferent format, the input format statement in the 
special input routine may be modified. The general 
rules for program modification are described 
later. 



73-75 Number of observations 

in the 25th group 

Leading zeros are not required to be keypunched. 

Data Cards 

Since input data are read into the computer one ob- 
servation at a time, each row of data in Table 5 is 
keypunched on a separate card, usii^ the format 
(12 F(6, 0)). This format assumes twelve 6-column 
fields per card. 

If there are more than twelve variables in a 
problem, each row of data is continued on the sec- 
ond and third cards until the last data point is key- 
punched. However, each row of data must begin on 
a new card. 

If there is more than one data card per observa- 
tion, the data card count indicator (NCARD), which 
appears in columns 11-12 of the first control card, 
must be chained to agree with the number of data 
cards per observation. 
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Deck Setup 

The deck setup is shown in Figure 26. 




Last problem 



Second problem 



First problem 




Procedures and main program 



Figure 26. 

Sample 

The listing of input cards for the sample is shown 
in Figure 27. 



SACPLE 


4 6 1 










10 


a 7 


7 8 










20 




IC 




8 


24 


8 


30 




12 




8 


22 


7 


40 




3 




8 


9 


S 


50 


16 


2 




2 


7 


2 


60 




10 




8 


23 


9 


70 


17 


3 




8 


6 


3 


80 




IC 




8 


29 


16 


90 




IC 




8 


26 


18 


100 




10 


27 


8 


28 


16 


110 


11 


7 




9 


e 


15 


120 




IC 




8 


27 


16 


130 




6 




14 


14 


13 


140 




fl 




6 


18 


2 


15C 




S 




2 


19 


9 


160 




IC 




8 


27 


17 


170 




11 




15 


2C 


10 


180 




4 


10 


7 


9 


9 


190 




13 


10 


7 


21 


15 


200 




5 


16 


16 


16 


7 


210 




9 


10 


5 


23 


11 


220 




IC 




8 


27 


16 


230 


17 


3 




7 


6 


3 


240 




10 




8 


23 


8 


250 




12 




8 


23 


7 


260 




3 




8 


21 


7 


270 


15 


2 




2 


7 


2 


280 




IC 


26 


8 


27 


16 


290 




S 




8 


26 


16 


300 




8 




9 


18 


2 


310 




10 




8 


26 


16 


320 



Figure 27. 
Output 

Description 

The output of the sample program for discriminant 
analysis includes: 

1. Means of variables in each group 

2. Pooled dispersion matrix 

3. Conninon means 

4. General Mahalanobis D-square 

5. Constant and coefficient of each discriminant 
function 

6. Probability associated with the largest dis- 
criminant fmiction evaluated for each observation 

Sample 

The output listii^ for the sample problem is shown 
as Figure 28. 



DISCRIMiNANT 4NftL¥SIS 


SAMPLE 














NUMBER OF GROUPS 
NUMBER OF VARIABLES 
SAMPLE SIZES.. 
GROUP 


4 
6 

8 

7 
7 
« 
















2 
3 
4 














GROUP 


1 MEANS 
7.8750C 


7.5CCCC 


4.62500 


T.Z5CC0 


16 


500CO 


8 


87500 


GROUP 


2 MEANS 
7.14286 


8.57143 


■9.57143 


7.85714 


20 


14285 


12 


57143 


GROUP 


3 MEANS 
7.85714 


7.85714 


8.85714 


9.28571 


17 


42856 


10 


142 86 


GROUP 


4 MEANS 
7.75OC0 


8.0CCC0 


6.750C0 


7.37500 


21 


37500 


9 


250CC 


POOLED 


DISPERSION MATRIX 














ROM 1 


19.61876 


11.16208 


-5.21497 


-6.C9890 


-22 


74855 


-9 


54052 


ROW 2 


11.16208 


11.94505 


5.61813 


1.91758 


22 


60982 


10 


66757 


ROM 3 


-5.21497 


5.61813 


39.45938 


3.93681 


16 


23486 


9 


34546 


ROM 4 


-6.09890 


1.91758 


3.93681 


9.83310 


4 


62156 


3 


83791 


ROU 5 


22.74855 


22.60982 


16.23486 


4.62156 


62 


78633 


3C 


18262 


ROW 6 


-9.54052 


10.66757 


9.34546 


3.83791 


30 


18262 


29 


57480 



Figure 28. 
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COMMON MEANS 

7.66667 



GENERALIZED MAHALANOBIS D-SOUARE 12.78063 

DISCRIMINANT FUNCTION 1 

CONSTANT * COEFFICIENTS 

-28. 4^9^31 * 

2.53870 2,1?2C9 -0.1 

OISCIMENANT FUNCTION 2 

CONSTANT * COEFFICIENTS 

-2q.21C17 • 

2.6193C 2.2523C -0.0 

DISCRIMINANT FUNCTION ? 

CONSTANT • COEFFICIENTS 

-31.86435 * 

2.T'.45C 2.39588 -0.0 

DISCFIMINANT FUNCTION A 

CONSTANT * COEFFICIENTS 

-3C.82C28 * 

2.7186C 2.C3937 -0.1 

EVALUATION PR CLASSIFICATION FUNCTIONS FOR EACH OBSERVATION 



GROUP 1 
OBSERVATION 



OSSECVATION 



OeSERV/'T ION 



OBSERVATION 



PROBABILITY ASSOCIATED WITH 
LARGEST DISCRIMINANT FUNCTION 
C. 38065 
C.37C*5 
r. 36261 
C. 4^1 90 
C.3'*454 
C. 442 15 
C. 31787 
C. 29274 

PROBABILITY ASSOCIATED WITH 
LARGEST OISCFIMINANT FUNCTION 
C.51C29 

C.5CC6C 
C.3476C 
C.43130 
C.442 82 
C.364C7 
C.28515 



PRCeflBILlTY ASSnCIATED WITH 

LARGEST DISCPIMINiiNT FUNCTION 
C,6761l 
C. 46629 
C. 54636 
C. 66688 
0.3C600 
C. 33043 
C.39C05 



PROBABILITY ASSOCIATED MITH 
LARGEST DISCRIMINANT FUNCTION 
C.33727 
C. 37475 
C. 62340 
C.456S7 
C, 52175 
C. 34061 
0.43135 
0.27849 



END OF SAMPLE PROGRAM 



Figure 28. (Continued) 



LARGEST 
FUNCTION NO. 



LARGEST 
FUNCTION NO. 



LARGEST 
FUNCTION NO. 



LARGEST 
FUNCTION NO. 



Program Modification 

1. Changes in the input format statement of the 
special input routine, DAT2: 
Only the format statement for input data may be 
changed. Since sample data are either one- or 
two-digit numbers, rather than usii^ six-column 
fields, as in the sample problem, each row of data 
might have been keypunched in two-column fields; 
if so, the format is chained to (6 F(2, 0)). This 
format assumes six 2-column fields per card, 
beginnii^ in column 1. 



2, If there are more than twelve variables in a 
problem, each row of data is continued on the sec- 
ond card until the last data point is keypunched. 
However, each row of data must begin in a new 
card. If there is more than one data card per ob- 
servation, the value of the data card count indicator 
(NCARD), which appears in columns 11-12 of the 
first control card, must be changed to agree with 
the number of data cards. 
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Operating Instructions 

The sample program for discriminant analysis is a 
standard PL/I program. Special operating instruc- 
tions are not required. Data set SYSIN is used for 
input; data set SYSPRINT, for output. 

Timii^ 

The execution of this sample program on a System/ 
360 Model 40, using an IBM 2540 Card Reader as 
input and an IBM 1403, Model Nl, as output, is 28 
seconds. 



MOSC. HDSC 10 

/**«*«*«***«*«««***««***«**»***«***«*«««*«*****«*««*«***«********«****/HO$C 20 

/♦ */MDSC 30 

/* TO READ THE PROBLEM PARAMETER CARD AND DATA FOR DISCRIMINANT ♦/HOSC 40 

/* ANALYSIS, CALL THE PROCEDURES TO CALCULATE VARIABLE MEANS IN */M0SC 50 

/* EACH GROUP, POOLED DISPERSION MATRIX, COMHON COEFFICIENTS OF •/MOSC 60 

/* DISCRIMINANT FUNCTIONS AND PROBABILITY ASSOCIATED MITH LARG- •/HOSC 70 

/* EST DISCRIMINANT FUNCTION OF EACH CASE IN EACH GROUP* AND VMOSC 80 

/* PRINT THE RESULTS. VMOSC 90 

/« */HOSC 100 

/**«********«*««******«**««««**********««*************««**«*****««««**/MDSC 110 

PROCEDURE OPTIONS (MAIN),. MOSC 120 

DECLARE HOSC 130 

(I,J,K,L,MtNl,N2,NN> HOSC 140 

FIXED BINARY, MOSC 150 

PRl CHARACTER 16), HOSC 160 

ERROR EXTERNAL CHARACTER CD, MOSC 170 

{NCARO,NV) EXTERNAL, MOSC 180 

CH CHARACTER (80),. HOSC 190 

/♦ */MOSC 200 

ON ENOFILE (SYSIN) GO TO EXIT,. MDSC 210 

SlOO,. HOSC 220 

GET EDIT (CH) (AI80)),. HOSC 230 

GET STRING (CH) EDIT (PR1,K,H,NCAR0) (A(6),3 F(2)),. HOSC 240 

/* t/MOSC 250 

/* PRl PROBLEM NUMBER (MAY BE ALPHAMERIC) */NDSC 260 

/* K NUMBER OF GROUPS »/HDSC 270 

/• M NUMBER OF VARIABLES •/MOSC 280 

/* NCARO.. ..NUMBER OF CARDS PER OBSERVATION */MDSC 290 

/* */HOSC 300 

NCARD=NCARD*80,. MOSC 310 

NV '0,. MOSC 320 

ONE.. MDSC 330 

BEGIN.. HOSC 340 

DECLARE HOSC 350 

N(K) FIXED BINARY, MOSC 360 

IXBAR(H.K),C(H+I,K),D(M,M),CMEAN(H)*OET,V,CON) HOSC 370 

BINARY FLOAT,. /*S1NGLE PRECISION VERSION /*S«/HOSC 380 

/* BINARY FLOAT (53),. /♦DOUBLE PRECISION VERSION /•0*/M0SC 390 

/» */HOSC 400 

/♦ READ SAMPLE SIZE OF EACH GROUP */MDSC 410 

/• ♦/MOSC 420 

GET EDIT (CH) (A(80)),. MOSC 430 

GET STRING (CH) EDIT ((N(I) DO 1= 1 TO K) ) MDSC 440 

(25 F(3)),. HOSC 450 

NN =SUM (N),. MOSC 460 

TWO.. HOSC 470 

BEGIN,, HOSC 480 

DECLARE HOSC 490 

LG(NN) FIXED BINARY, HOSC 500 

X(NN,H} FLOAT BINARY, HOSC 510 

P(NN) MDSC 520 

BINARY FLOAT,. /♦SINGLE PRECISION VERSION /•S«/MOSC 530 

/♦ BINARY FLOAT (53),. /♦DOUBLE PRECISION VERSION /•D*/HOSC 540 

PUT EDIT ('DISCRIMINANT ANALYSIS ',PR1, ' NUMBER OF 6R0UPS>*K, HOSC 550 

• NUMBER OF VARI ABLES* ,M, * SAMPLE SI ZES. .',• GROUP' 1 MOSC 560 

(PAGE.SKIP(4),COLUHNI10»,A,A.SKIP(2),COLUMN(lO),A,xr7),F(3), HOSC 570 

SKIP(l),COLUHN(10},A.FI7),SKIP(l>*C0LUMNtl0),A,SKIP(t), NDSC 5S0 

C0LUHN(22),A),. HOSC 590 

PUT EDIT ((I,N(I) 00 I> 1 TO Kl) tSKIP(l) ,COLUHNt22),F(3) ,X(8), HOSC 600 

F<4)),. HOSC 610 

PUT EDIT (• •) (SKIP*2I,A»,. MOSC 620 

/« ♦/HOSC 630 

/♦ READ IN DATA. IN THE MANNER EQUIVALENT TO A 3-OIMENSIONAL ♦/MDSC 640 

/♦ ARRAY X(l,l,ll,Xf2,l*l>,X(3,l,l),ETC. THE FIRST SUBSCRIPT ♦/HOSC 650 

/* IS THE CASE NUMBER, THE SECOND SUBSCRIPT IS THE VARIABLE ♦/MDSC 660 

/« NUMBER AND THE THIRD SUBSCRIPT IS THE GROUP NUMBER ♦/HOSC 670 

/* ♦/HOSC 680 

DO I = 1 TO NN,. HOSC 690 

CALL 0AT2 <H,CHEAN),. MOSC 700 

00 J * 1 TO M,. HOSC 710 

Xli*J)=CMEAN(JI,. MOSC 720 

END,. HOSC 730 

END,. MOSC 740 

CALL OHTX {K,H.N,X,X6AR*0),. MOSC 750 

IF ERROR NE 'O* HOSC 760 

THEN DO,. HOSC 770 

PUT EDIT ('IN ROUTINE DMTX ERROR CODE = '.ERROR) MOSC 780 

(SKIP(2),C0LUMN(10).A.AIU),. HOSC 790 

GO TO FIN*. MDSC 800 

END,. MDSC 610 

/♦ ♦/HOSC 820 

/♦ PRINT MEANS AND POOLED DISPERSION MATRIX ♦/MOSC 830 

/♦ ♦/MOSC 840 

DO I ■ 1 TO K,. MOSC 850 

PUT EDIT ('GROUP*, I, 'MEANS') (SKIP (2 ),COLUHN( 11 ) , A,F(3) , X( 2) , HOSC 860 

A),. MDSC 870 

PUT EDIT ((XBAR(J,I) DO J= 1 TO M) ) (SKIP( 1 ) ,COLUMNI 10) , MDSC 880 

(6)F(1S,5)),. HOSC 890 

END,. HOSC 900 

PUT EDIT (*POOLEO DISPERSION MATRIX') ( $KIP( 3) ,COLUHN( 10) , A) , . MOSC 910 

00 1 ■ 1 TO M,. MDSC 920 

PUT EDIT ('ROM', I) (SKIP(2 ) .COLUMN! 10) , A,F(3) ), . HOSC 930 

PUT EDIT 1(0(1, J) 00 J= I TO M)) ( SKIP.COLUMNt 10) ,6 F(I5,5)).. HOSC 940 

END,. HOSC 950 

CON *0,. HOSC 960 



.ERROR) (SKIP(2), 



CALL HINV (D,M,D£T,CON),. 
IF ERROR NE '0' 
THE)4 DO,. 

PUT EDIT ("IN ROUTINE HINV ERROR CODE = 

COLUMN(10),A.A(1)>,. 
GO TO CONT.. 
END.. 
CALL OSCR (K.M.N, X.XBAR,0,CHEAN,V,C,P,LG),. 
IF ERROR NE *0* 
THEN DO,. 

PUT EDIT I'lN ROUTINE OSCR ERROR CODE = '.ERROR) 

(SKIP(2),C0LUMN(10>.A,A(1)),. 
GO TO SlOO.. 
END,. 
/• 

/♦ PRINT THE COMMON MEANS. 

/♦ 

PUT EDIT ('COMMON MEANS') (SKIP(4),C0LUHN( 10),A) , , 

PUT EDIT ((CHEAN(I) DO 1= 1 TO M)) ( SKI P, COLUMN! 10) , (6)F( 15,5) », . 
/♦ 

/* PRINT GENERALIZED MAHALANOBIS D-SQUARE 

/♦ 

PUT EDIT ('GENERALIZED MAHALANOBIS D-SQUARE*, V) 
(SKIP<4),C0LUMN(10),A,F(15,5],SKIPt2)l,. 
/* 

/* PRINT CONSTANTS AND COEFFICIENTS OF DISCRIMINANT FUNCTIONS 

/* 

DO I = 1 TO K,. 

PUT EDIT COISCRIHINANT FUNCTION' ,1 ,' CONSTANT ♦', 

'COEFFICIENTS') (SKIP(2) ,COLUHNilO),A,F(3),SKIP(2) , 
COLUMN ( 16), A, X (3), A),. 
PUT EDIT !C(l,I).» * *) (SKIP(2),C0LUHNI10),F(14.5),A),. 
PUT EDIT ((C(J,I) DO J- 2 TO M+l») ISKIP,C0LUMN«32> , 

(6)F(14,5)),. 
END.. 
/• 

/♦ PRINT EVALUATION OF CLASSIFICATION FUNCTIONS OF EACH 
/* OBSERVATION. 
/♦ 

PUT EDIT ('EVALUATION OF CLASSIFICATION FUNCTIONS FOR EACH', 

' OBSERVATION') (SKIP(4) .C0LUMNI10),A,A), . 
Nl =1.. 
N2 =Ntl),. 

00 I = I TO K.. 

PUT EDIT ('GROUP'. I. 'PROBABILITY ASSI3CIATED HUH', 'LARGEST', 
' OBSERVATION', 'LARGEST DISCRIMINANT FUNCTION*. 
•FUNCTION NO.') 

ISKIP(2),C0LUMN(10),A,F(3),SKlP,C0LUMNI2e),A.X(ll»,A, 
SKIP,COLUMN<10),A,X(5),A,X<8),A),. 
L =0,, 

DO J - Nl TO N2.. 

L "L*l,. 

PUT EDIT (L*P(J),LGIJ)) ( $KIP,C0LUHN(10) .Ff 6),X(20) ,F( 8 

,X(20),F<6)t,. 
END,. 
IF I = K 

THEN GO TO CONT,. 
Nl =N1+N11),. 
N2 =N2+N(I>1),. 
END,. 
CONT.. 
END,. 
END,. 

GO TO SlOO,. 
EXIT.. 

PUT FILE (SYSPRINT) EDIT I 'END OF SAMPLE PROGRAM') 
( SKI P ( 5 ) , COLUMN ( 1 ) ,A ) , . 
FIN.. 

END,. /*ENO OF PROCEDURE MOSC 



MOSC 970 

HOSC 980 

HOSC 990 

NDSC 1000 

HOSClOlO 

MOSC 1020 

H0SC1030 

HOSC 1040 

MOSC I 050 

M0SC1060 

MDSC1070 

MDSC 1080 

MOSC 1090 

HOSC 1100 

♦/MDSC 1110 

♦/H0SC1120 

♦/HD SCI 130 

MDSC1140 

HDSC1150 

♦/MDSC1160 

•/M0SC1170 

♦/H0SC1180 

MDSCil90 

MDSC 1200 

♦/HDSC1210 

♦/HOSC1220 

♦/HDSC1230 

HOSC 1240 

HDSC1250 

MDSC1260 

MDSC12T0 

MD SCI 280 

MDSC1290 

MDSC 1300 

HDSC1310 

♦/H0SC1320 

♦/HOSC 1330 

♦/MOSC 1340 

♦/HDSC1350 

HOSC 1360 

HOSC1370 

M0SC1380 

MDSC1390 

MDSC 1400 

M0SC1410 

HDSC1420 

M0SC1430 

MOSC 1440 

MDSC1450 

HDSC1460 

HOSC 1470 

HOSC 1480 

,5)M0SC1490 

MDSC 1500 

HOSCISIO 

HDSC1S20 

HOSC 1530 

HOSC 1540 

M0SC1550 

HOSC 1560 

HOSC 1570 

HDSC1580 

MOSC 1590 

M0SC1600 

M0SC1610 

nOSC1620 

HOSC 1630 

MDSC 1640 

♦/HDSC1650 



**»**««»««*: 



TO READ FLOATING POINT OfiTA, ONE OBSERVATION AT A 

DATA MAY BE SAVED ON fl DATA SFT . 



«»«««** 



*«««***»* 



PROCEDURE (M,D),. 
DECLARE 

XDATA FILE STREAM ENVIRONMENT (CONSECUT(VE V(2C0O 

(NCARO, NV) EXTERNAL, 

CH CHftBACTERINCARD) , 

( ! ,M,HM) FIXED BINARY, 

0(*) FLOAT BINARY,. 
/* 

ON ENOFILE (SYSINI 

GO TO EXIT,, 

GET EDIT (CH) (A(NCARD)l,. 

MM =CEIL(M/X2),. 

GET STRING ICH) EDIT ((0(1) DO 1= 1 TO M)) 

UMM)(( 12)FIt.,C) .X(8) )) ,. 
IF NV= 1 

THEN PUT FILE (XOATA) EDIT ((D(I) DO 1= 1 TO M)) ((M)F 
REVERT FNOFILS (SVSIN),. 
RETURN. . 
EX(T.. 

PUT FILE (SYSPRINT) EDIT ('ERROR INSUFFICIENT DATA') 

(SKIP( I) .COLUMN! 10) ,A) , . 
STOP,. 
ENO,. /*END OF PROCEDURE 





DAT? 


IC 


««:«.«««:K 


*«»«»»/r)flT2 


?C 




«/0AT2 


30 


TIME. 


«/DAT2 


4C 




«/0AT2 


50 




*/DaT2 


60 


**«***! 


*«*«*!ft/0flT2 


70 




DAT2 


8C 




0AT2 


9C 


,2CC)), 


Oil? 


100 




DflT2 


110 




DAT2 


12C 




DaT2 


130 




DAT2 


140 




*/DAT2 


150 




OftT2 


16C 




DAT2 


170 




DAT2 


IfiO 




OAT 2 


19C 




DAT2 


?oc 




DAT2 


?IC 




0AT2 


22C 


(6,C)) 


0AT2 


?10 




0AT2 


240 




0AT2 


2 50 




0AT2 


260 




OflT2 


?7C 




0AT2 


?ftO 




0AT2 


290 


DAT? 


*/DAT2 


300 



PRINCIPAL COMPONENTS ANALYSIS FACT 

Problem Description 

A principal component solution and the varimax 
rotation of the factor matrix are performed. Prin- 
cipal components analysis is used to determine the 
minimum number of independent dimensions needed 
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to account for most of the variance in the original 
set of variables. The varimax rotation is used to 
simplify columns (factors) rather than rows (vari- 
ables) of the factor matrix. 

The sample problem for principal components 
analysis consists of 23 observations with nine 
variables, as presented in Table 6. In order to 
keep the number of independent dimensions as small 
as possible, only those eigenvalues (of correlation 
coefficients) greater than or equal to 1.0 are 
retained in the analysis. 

Table 6. Sample Data for Principal 
Components Analysis 



Observation 


X, 


Xz 


X3 


X4 


Xs 


Xe 


X7 


Xs 


X9 


1 


7 


7 


9 


7 


15 


36 


60 


15 


24 


2 


13 


18 


25 


15 


13 


35 


61 


18 


30 


3 


9 


18 


24 


23 


12 


43 


62 


14 


31 


4 


7 


13 


25 


36 


11 


12 


63 


26 


32 


5 


6 


8 


20 


7 


15 


46 


18 


28 


15 


6 


10 


12 


30 


11 


10 


42 


27 


12 


17 


7 


7 


6 


11 


7 


15 


35 


60 


20 


25 


8 


16 


19 


25 


16 


13 


30 


64 


20 


30 


9 


9 


22 


26 


24 


13 


40 


66 


15 


32 


10 


8 


15 


26 


30 


13 


10 


66 


25 


34 


11 


8 


10 


20 


8 


17 


40 


20 


30 


18 


12 


9 


12 


28 


11 


8 


45 


30 


15 


19 


13 


11 


17 


21 


30 


10 


45 


60 


17 


30 


14 


9 


16 


26 


27 


14 


31 


59 


19 


17 


15 


10 


15 


24 


18 


12 


29 


48 


18 


26 


16 


11 


11 


30 


19 


19 


26 


57 


20 


30 


17 


16 


9 


16 


20 


18 


31 


60 


21 


17 


18 


9 


8 


19 


14 


16 


33 


67 


9 


19 


19 


7 


18 


22 


9 


15 


37 


62 


11 


20 


20 


8 


11 


23 


18 


9 


36 


61 


22 


24 


21 


6 


6 


27 


23 


7 


40 


55 


24 


31 


22 


10 


9 


26 


26 


10 


37 


57 


27 


29 


23 


8 


10 


26 


15 


11 


42 


59 


20 


28 



Program 

Description 

The principal components analysis sample program 
consists of a main routine, FACT, a special input 
routine named DAT2, and five subroutines from the 
Scientific Subroutine Package: CORE, MSDU, 
TRAC, LOAD, and VRMX. 

Capacity 

The capacity of the sample program and the format 
required for data input have been set up as follows: 

1. Up to 96 variables can be read. 

2. Up to 99999 observations can be read. 

3 . Up to eight data cards per observation can be 
read. 



4. (12 F(6,0)) format for input data cards. 
Therefore, if a problem satisfies the above condi- 
tions, it is not necessary to modify the sample 
program. However, if input data cards are pre- 
pared using a different format, the input format 
statement in the input procedure, DAT2, must be 
modified. The general rules for program modifi- 
cation are described later. 

Input 



Control Card 






Columns 


Contents 


For 


Sample Problem 


1-6 


Problem number 
(may be alphameric) 




SAMPLE 


7-11 


Number of obser- 








vations 




00023 


12-13 


Number of variables 




09 


14-19 


Value used to limit 




0001. 



20-21 



the number of eigen- 
values of correlation 
coefficients. Only 
those eigenvalues 
greater than or equal 
to this value are re- 
tained in the analysis. 
(A decimal point 
must be specified. ) 
Number of data 
cards per observa- 
tion. 



01 



Leading zeros do not have to be keypunched. 

Data Cards 

Since input data are read into the computer one ob- 
servation at a time, each row of data in Table 6 is 
keypunched on a separate card, using the format 
(12 F(6,0)). This format assumes twelve 6-column 
fields per card. 

If there are more than twelve variables in a 
problem, each row of data is continued on the second 
and third cards until the last data point is keypunched. 
However, each row of data must begin on a new card. 

Deck Setup 

The deck setup is shown in Figure 29. 
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Lost problem 



^, M S Second problem 




Procedures and main program 



Figure 29. 



SAHnECCC23C90C01.C 


1 












10 




7 


9 


7 




36 


60 


15 


24 


20 


13 


le 


25 


15 




35 




18 


30 


30 




18 


24 


23 




43 




14 


31 


40 




13 


25 


36 




12 




26 


32 


50 






20 


7 




46 




28 


15 


60 


IC 


12 


30 


U 




42 




12 


17 


70 






11 


7 




35 




20 


25 


80 


16 


15 


25 


16 




30 




2C 


30 


90 




22 


26 


24 




40 




15 


32 


100 




IE 


26 


30 




10 




25 


34 


110 




10 


20 


8 




40 




30 


Id 


120 




12 


28 


11 




45 




15 


19 


130 


11 


17 


21 


3C 




45 




17 


30 


140 




16 


26 


27 




31 




19 


17 


150 


IC 


14 


24 


18 




29 




IB 


26 


160 


11 


11 


30 


19 




26 




20 


30 


]70 


16 




16 


20 




31 




21 


17 


180 






19 


14 




33 




9 


19 


!90 




18 


22 


9 




37 




11 


20 


<ao 




11 


23 


18 




36 




22 


24 


no 






27 


23 




40 




24 


31 


:!0 


10 




26 


26 


IC 


37 




27 


29 


■ '.T 


e 


10 


26 


15 


11 


42 




20 


28 


<■ 



Figure 30. 
Output 

Description 

The output of the sample program for principal 
components analysis includes: 

1. Means 

2. Standard deviations 

3. Correlation coefficients 

4. Eigenvalues 

5. Cumulative percentage of eigenvalues 

6. Eigenvectors 

7. Factor matrix 

8. Variance of factor matrix for each iteration 
cycle 

9. Rotated factor matrix 
10. Check on communalities 



Sample 



Sample 



The listing of input cards for the sample problem is 
shown in Figure 30. 



The output listing for the sample problem is shown 
in Figure 31. 



PRINCIPAL COMPONENT ANALYSIS SAMPLE 



NO. OF CASES 
NO. OF VARIABLES 



STANDARD DEVIATIONS 

2.70412 4.59';78 

5.56563 6.09249 

CORRELATION COEFFICIENTS 



ROM 1 

1.00000 



ROM 2 

0.34987 



ROW 3 

0.11975 



ROW 5 

0.21917 



0.34987 
l.OCOOC 
CilSll 
0.35572 
-0.08243 



ROW 6 

-0.09549 -0,09100 



ROW 7 

0.20901 



ROM 8 

-0.12908 -C. 32044 



ROW 9 

0.05818 0.35387 



0.11975 

0.41311 

l.OOOOC 

0.41512 

-0.43179 

-0.08 346 

-0.10252 

0.03215 

C. 27833 



0.12102 
0.35572 
C. 41512 
l.OOOOC 
-0.31288 
-C. 50365 
0.49856 
0.22539 
0.59890 



18.00000 


12.86957 


34 


82608 


54 


00000 


8.33393 


3.13781 


9 


29149 


14 


87826 


0.21917 


-0.09549 


0.20901 


-0.12908 




0,05318 


-0.08243 


-0.09100 


0.29622 


-0.32044 




0.35387 


-0.43179 


-0.08346 


-0.10252 


0.03215 




0.27833 


-0.31288 


-0. 5036 5 


0.A9856 


C. 22539 




0. 598'JC- 


I. 00000 


-0.23000 


0.03310 


-0.00475 




-0.3C341 


-0.23000 


l.OCOOO 


-0.44520 


-0.25441 




-0.37456 


0.03310 


-0.44520 


l.OOOOC 


-0. 28050 




0.6C124 


-0.00475 


-0.25441 


-0.2805C 


l.OCOOO 




0.13516 


-0.30341 


-0.37456 


0.60124 


0.13516 




l.OCOCC 



Figure 31. 
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EIGENVALUES 
2.9*988 


1.64 368 


1.55514 


1.06579 












CUMULATIVE PERCENTAGE OF EIGENVALUES 
0.32776 C.51C40 0.68319 


0.80161 












EIGENVECTORS 


















VECTOR I 

0.16't37 


0.34836 


0.28797 


0.49661 


-0.16806 


-0.32922 


0.39935 


0.01287 


0.47518 


VECTOR 2 


















0.34837 


0.06552 


-0.44647 


-0.11893 


0.61210 


-0,26428 


0.38860 


-0.24845 


-0.06014 


VECTQf 3 

-0.29899 


-0.46835 


-0.23534 


0,17377 


0.14468 


-0.43545 


0.01681 


0.61587 


0.12470 


VECTOR 4 

0.54*.*.! 


0.16909 


e. 38288 


0.04163 


0.30537 


-0.16163 


-0.43410 


0.4C283 


-0.23789 


FftCTOR MATRIX 


( 4 FACTPfiSI 
















VARIABLE I 

0.23232 


0.4466 3 


-0,37286 


0.56203 












VARIABLE 2 
0.59831 


0.0840C 


-0.5 8394 


C. 17457 












VARIABLE 3 

0.4946C 


-0.572'.0 


-0.29346 


0.395 2 8 












VARIflSie 4 
0.65293 


-0.15248 


0.21671 


0.04297 












VARIABLE 5 
-0.28665 


0.78475 


0.18C43 


C. 31525 












V API A RLE 6 
-0.56544 


-0.33882 


-0.543C3 


-0.15686 












VARIABLE 7 


0.49621 


0.C2345 


-0.44616 












VARIABLE 8 

0,02211 


-0.31853 


0.768C2 


0.41587 












VAOIABLE 9 

0.81614 


-0.07710 


0.15551 


-0,24559 












ITERATTON 
CYCLE 


1 

2 
3 

4 

5 

6 

7 

8 

9 
10 
11 
12 


VARIANCES 

0.2112PS 
0.336136 
0.397020 
0,403004 
0.405175 
0.4C5527 
0.4C5579 
0.4C5586 
0.4C5586 
0.405586 
0.4C5586 
0.4C55S6 
0.4C5586 
















ROTATED FACTOP 


MATOIX ( 4 


FACTORS) 














VARIABLE i 

0.05496 


0.07183 


-0.C5578 


0.85017 












VAPIA8LE 2 

0.29329 


-0.39653 


-0.35581 


0.60549 












VARIABLE 3 
C.C5U4 


-0.82493 


0.15C68 


0.32984 












VARIABLE 4 
C.74G40 


-C.414C1 


0.24579 


0.13972 












VAOIABLE 5 
-C.C9091 


0.8C6S2 


0.13525 


0.39228 












VARIABLE 6 
-0.66236 


-0.21579 


-0.44983 


-0.20503 












VARIABLE 7 
0.86997 


0.18299 


-0.34918 


C.C883C 












VARIABLE 3 

O.C36C2 


-0.05500 


0.91375 


-0.15962 












VARIABLE 9 
C.8C531 


-0.32759 


0.00994 


-0.C238C 












C^^ECK ON COMMUNAL ITIES 
















VARIABLE 
1 
? 

5 

6 

7 
8 


ORIGINAL 

C.734C9 
0.73649 
C. 6 1464 
C. 79955 
C. 83109 
0.75725 
C. 92006 
C. 86476 
0,76652 


FINAL 
0.73408 
0.73647 
0.81463 
0.79954 
0.83107 
0.75724 
C. 92005 
C. 86474 
0.75651 


DIFFERENCE 
O.OOOOl 
0.0000 I 
0.00001 
0.00001 
0.00001 
0.00001 
0.00001 
0,00001 
0.00001 










ENO OF SAMPLE 


PROGRAM 

















Figure 31. (Continued) 
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Program Modifications 

Input data in a different format can also be handled 
by providing a different format statement. In order 
to familiarize the user with the program modifica- 
tions, the following general rules are supplied in 
terms of the sample problem: 

1. Changes in the input format statement of the 
special input subroutine, DAT2: 

Only the format statement for input data may 
be changed. Since sample data are either one- or 
two-digit numbers, rather than using six-column 
fields as in the sample problem, each row of data 
might have been keypunched in two-column fields; if 
so, the format is changed to 9F(2,0). This format 
assumes nine 2-column fields per card, beginning in 
column 1. 

The special input subroutine, DAT2, is 
normally written by the user to handle different 
formats for different problems. The user may 
modify this procedure to perform testing of input 
data, transformation of data, and so on. 

2. If there are more than twelve variables in a 
problem, each row of data is continued on the 
second and third cards until the last data point is 
keypunched. However, each row of data must begin 
on a new card. If this condition exists, the value 
of the data card count indicator (NCARD) , which 
appears in columns 20-21 of the control card, must 
be changed to agree with the number of data cards 
per row. 

Operating Instructions 

The sample program for principal components 
analysis is a standard PL/I program. Special 
operating instructions are not required. Data set 
SYSIN is used for input; data set SYSPRINT, for 
output. 

Timing 

The execution of this sample program on a System/ 
360 Model 40, using an IBM 2540 Card Reader as 
input and an IBM 1403, Model Nl, as output, is 45 
seconds. 



FACT.. 












FACT 


IC 








• «#«* 


**/FACT 


20 


/* 












*/FACT 


30 


/« TO READ THE PROBLEM PARAMETER 


CARD 


CALL FIVE 


>ROCEDURES TO 


*/FACT 


^0 


/* PERFORM A PRINCIPAL COMPONENT 


SOLUTION 


AND THE 


VARI'iAX 


ROTA- 


*/FACT 


50 


/* HON OF A FACTOR MATRIX, AND 


'RINT 


THE 


RESULTS 






*/FACT 


60 


/* 












*/F4CT 


70 




K******** 




**/FACT 


80 


PROCEDURE OPTIONS (MAINl,. 












FACT 


90 


DECLARE 












FACT 


100 


(I.IO.J.KtM.MV.N.NCNU) 












FACT 


no 


FIXED BINARY, 












FACT 


12C 


ERROR EXTERNAL CHARACTERt 1) , 












FACT 


130 


(NV.NCAPDl EXTEf^NAL, 












FACT 


I'iO 


CON 












FACT 


150 


FLOAT BINARY, 












FACT 


150 


PRl CHARACTER (6), 












FACT 


170 


CH CHARACTER (BOJ,. 












FACT 


18C 


/• 












*/FACT 


190 


ON ENOFILE (SYSIN) GO TO EXIT.. 












FacT 


2C0 



SlOC. 

GET EDIT (CH> (AISOII.. 

GET STRING (CH) EDIT ( PR I, N, M, CON, NCARD) I A(6t , Fl 51 ,F( 2) ,F (6,0) 
F(2}),. 

PRl PRCBLEH NUMBER (MAY BE ALPHAMERIC ) 

N NUMBER OF CASES 

M NUMBER OF VARIABLES 

CON CONSTANT USED TC CECIDE HOH MANY EIGENVALUES 

TO RETAIN 
NCARD NUMBER OF DATA CARDS PER OBSERVATION 

NCARD=NCAR0*80,. 
ONE.. 

BEGIN,. 
DECLARE 

(R(M,Mt,V(M.MJ,eiMl,D(M).S(M),T(M)TXBARIM),TV(5l),X(l,l)) 

BINARY FLOAT,. /*SINGLE PRECISION VERSION 

/* BINARY FLOAT (53),. /«DOUBLE PRECISION VERSION 



FACT 21C 

FACT 220 

, FACT 230 

FACT Z'-O 

*/FACT 250 

♦/FACT 260 

•/FACT 270 

*/FACT 280 

*/FACT 290 

♦/FACT 300 

•/FACT 310 

♦/FACT 320 

FACT 330 

FACT 340 

FACT 350 

FACT 360 

FACT 37C 

/♦S*/FACT 380 

/♦0*/FACT 390 



'.PRl. 



•NO. OF CASES' 



PUT EDIT ('PRINCIPAL COMPONENT ANALYSIS 

h.'NO. OF VARIABLES'. M) 

(PAGE,SKIP(<.),COLUMN(101,A.A,SKIPt2),COLUMN(13).A,X(4),F(6) 

,SKIP(1),C0LUMN(13>.A,FI6),SKIP),. 



10 



NV 



=0, 



.XBAR,StV.R,D), 



CALL CORR (Nfl 
IF ERROR NE 'C 
THEN DO,. 

PUT EDIT ('IN ROUTINE CORK ERROR CODE = ', ERROR) 

<SKIP(2),COLUMN(10),A,A(l) }.. 
GO TO SlOC 
END,. 
PUT EDIT ('MEANS') ( SKIP (2) .COLUMN( ICI , A) , . 

PUT EDIT ({XBAF(J) 00 J= I TO M)) ( SKIP,C0LUMN( 101 , 17) F( 15 ,5 ) ) , 
» 
t PRINT MEANS AND STANDARD DEVIATIONS 

PUT EDIT ("STANDARD DEVIATIONS') ( SK IP( 21 ,COLUHN( 10) , Al , . 
PUT EDIT ((S(J) DO J= 1 TC M)) ( SKI P,COLUMN( 10) , ( 71 F(I5, 5 ) ) t . 

» PRINT CORRELATION COEFFICIENTS 

* 

PUT EDIT CCCRRELATION COEFFICIENTS') ( SKIP* 21 ,CDLUMN( 10) , A) , . 

00 I = I TC M,. 

PUT EDIT CROW, I) ( SKIP( 21 ,COLUMN( 10) , A,F( 31 ) . 



FACT 400 

FACT 410 

FACT 420 

FACT 430 

FACT 440 

FACT 450 

FACT 460 

FACT 470 

FACT 490 

FACT 490 

FACT 500 

FACT 510 

FACT 5?C 

FACT 530 

FACT 540 

FACT 550 

♦/FACT 560 

•/FACT 570 

•/FACT 580 

FACT 590 

FACT 600 

•/FACT 610 

•/FACT 620 

♦/FACT 630 

FACT 640 

FACT 650 

FACT 660 



MV 



PUT EDIT ((R(I,J) DO J= 1 TC M)) ( SKIP,COLUMN( 101 ,9 F(12,5)1,. FACT 670 

FACT 680 
FACT 69C 



END, 



CALL MSOU (R.V.M.MVl.. 
IF ERROR NE '0' 
THEN DO, . 

PUT GOIT ('IN ROUTINE MSDU ERROR CODE *, ERROR) 
(SKIP{2) .COLUMNUC)*A,A( I) ), . 

GO TO SKC. 

END,. 
CALL TftAC (M,P ,CON,K,D).. 
IF ERROR NE 'C 
THEN DO,. 

PUT EDIT ('IN ROUTINE TRAC ERROR CODE = ', ERROR) 
(SKIP(2),COLUMN(10),A,A(l) ),. 

GO TO SlCC 

ENO, . 

DO I = 1 TO K,. /* PRINT EIGENVALUES 

S(I) =R(l,n .. 

ENO, . 
PUT EDI^ ( 'EIGENVALUES') 1 SKIP( 3 ) ,COLUMN( 10 ) , A) , . 
PUT EDIT ((S(J) DO J= 1 TO K)) I SK1P,C0LUMN( 10) .9 F(12,5II.. 

* PRINT CUMULATIVE PERCENTAGE OF EIGENVALUES 

PUT EDIT ('CUMULATIVE PERCENTAGE CF EIGENVALUES') 

( SKIP(2),C0LUMN( 10) , A).. 
PUT EDIT ((D(J) DO J= I TO K)l ( SK IP ,COLUHN( 10)f 9 F(12,5)),. 

(= PRINT EIGENVECTORS AND FACtOP MATRIX 

PUT EDIT ('EIGENVECTORS') ( SKI P(3) ,CCLUHN( 10 1 , A) , . 
CO J = 1 TO K,. 
PUT EDIT ('VECTOR', J) ( SKIP ( ?) ,COLUMN( 10 ) , A,F( 3) ) . . 



FACT 700 

FACT 710 

FACT 720 

FACT 730 

FACT 740 

FACT 750 

FACT 760 

FACT 770 

FACT 780 

FACT 790 

FACT 800 

FACT 810 

FACT 820 

FACT 830 

•/FACT 840 

FACT 850 

FACT 860 

FACT 870 

FACT 880 

•/FACT 890 

•/FACT 900 

♦/FACT 910 

FACT 920 

FACT 930 

FACT 940 

♦/FACT 950 

•/FACT 960 

•/FACT 970 

FACT 980 

FACT 990 

FACTIOCO 



PUT EDIT KVd.J) 00 1= I TC M) 1 ( SKIP,COLUMN( 10) ,9 F(12,5)),. FACTIOIO 



END, 
PUT EDIT ('FACTOR MATRIX {',K,' FACTORS)') 

(SMP(3),C0LUMN(101,A,F(3),A) ,. 
CALL LHAO (M,K,P,V».. 
IF ERROR NE 'C 
THEN DO, . 

PUT EDIT ('IN ROUTINE LOAD ERROR CODE = ', ERROR) 
<SKIP(2>.C0LUHN(10)(A,A(1) },. 

GO TO SlCC,. 

END.. 

00 I = 1 TO «.. 

PUT EDIT ('VARIABLE', 1) ( SK 1P( 2) .CQLUHNI XOI , A,F(3) ) . . 

PUT EDIT {(V(I.J) DO J= 1 TO Kl) (SKIP,COLUMN( 10 ) ,9 F(12,5M' 

END.. 
CALL VRHX (M>K,V.NC,TVt8,T,D),. 
IF ERROR NE 'C 
THEN DO, . 

PUT EDIT ('IN ROUTINE VRMX ERROR CODE = ', ERROR) 
(SKIP(2) ,COLUMN(10).A,A(1) ).. 

GO TO SIGC. 

END.. 
NW =NC+1,. /* PRINT VARIANCES 

PUT EDIT ('ITERATION', 'VARIANCES'.' CYCLE'l (SKIPC 31.C0LUHNU0I , i 

X(T) , A, SKIP, COLUMN (10), A},. 

DO 1 = 1 TO NW,. 

NC =1-1,. 

PUT EDIT (NCTVd)) ( SKIP.COLUMNdO 1 .F (5) ,F(20,61 1 , . 

END.. 

PRINT ROTATED FACTOR MATRIX 

PUT EDIT ('ROTATED FACTOR MATRIX CK,' FACTORS)*! 
(SK|P(3),C0LUMNI1C1,A,F(3),A),. 
DO I = 1 TO M,- 

PUT EDIT ('VARIABLE'. I) ( SKIP(2) .C0LUHN( 101 , A.F( 31 ) , . 
PUT EDIT ((Vd.Jl DO J= 1 TO K)) ( SKIP.CGLUHN( 10) ,9 F(12t5>) 
ENO, . 

► PRINT COMMONALITIES 

PUT EDIT ('CHECK ON CGHMUNALI TI ES '.' VARIABLE' . •ORIGINAL* .' FINAL' . 
•DIFFERENCE' ) ( SKIP( 3) ,COLUMN( IC) , A, SKIP( 2) .COLUHNt 10 1 , A. 
X(7t.A,X{12),A,X(10>,A),. 

DO I = 1 TO H,. 



FACT102C 

FACT1030 

FACT104C 

FACT! 050 

FACT1060 

FACT1070 

FACT1080 

FACT1090 

FACTllOO 

FACTIllO 

FACT1120 

FACT1130 

. FACT1140 

FACT1150 

FACT1160 

FACT1170 

FACT1180 

FACT1190 

FACT1200 

FACT1210 

FACT1220 

•/FACT1230 

U FACT124C 

FACT1250 

FACT1260 

FACri270 

FACT1280 

FACT1290 

♦/FACT1300 

♦/FACT1310 

•/FACT1320 

FACT 1 330 

FACT1340 

FACT1350 

FACT 1360 

, . FACT1370 

FACT1380 

•/FACT1390 

•/FACT1400 

•/FACT1410 

FACT1420 

FaCT1430 

FACT1440 

FACT1450 
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PUT EDIT lI.BCn.Tdl.Olll) (SKIP.COlUmilOl ,f ( 5),3 F( 18,51 ) , . FACTU60 

S200.. 

END,. 

GO TO SlCC. 
EXIT.. 



PUT FILE ISYSPRINT) EDIT CEND OF SAMPLE PROGRAM') 

(SKIP(5(,CGtUMN(10),A),, 
^'"'•- /•END OF PROCEDURE FACT 



FACT1470 
FACT1480 
FACTIMO 
FACT1500 



FACT1510 

FACT1520 

FACT1530 

*/FACT1540 



Note also that added problems arise when, in the 
one- sample case, the parameters of the continuous 
distribution in question are estimated from the 
sample. Lilliefors discusses these problems (see 
reference given in KLMO description). 



««»««*«««««**««»«, 



«««««««««**«: 



»V««««4:«# 



^tsV*:*** 



/* TO PEAD FLOATING POINT DATA, o^e OSSEfiVATION AT A TIME 

/* DATA MAY BE SAVED ON A DATA S^T. 

/• 

PROCEDUPE 1M,D),. 
DECtARE 

XDATA FILE STREAM ENVIftONMENT (CONSECUTIVE V( 20C0 , 20P ) I , 

(NCARD.NV) EXTERNAL, 

CH CHARACTERINCARO), 

(I .M,MM) FIXED BINARY, 

D(*l FLOAT BINARY,. 
/* 

TN ENDFILE 1 SVSIN) 

GO TO EXIT,. 

CET EDIT (CH) (A(NCARD»),. 

MM =CEIL{M/12),. 

GET STRING ( CH ) EDIT (IDII) DO 1= I TO M)) 

llMM)t(12)F(6,0),X(8))),. 
IF NV= 1 

THEN PUT FILE (XDATAt EDIT ((DU) DO 1= I TO M)) ((M)F(6,C)I, 
REVERT ENDFILE (SYSIN),, 
RETURN,. 
EXIT.. 

PUT FILE (SYSPRINT) EDIT ('ERROR rNSUFFICIENT DATA') 

( SKIP( 1), COLUMN (10) ,A) , . 
STOP,. 
^f*0,. /*eNO Of PROCEDURE DAT2 



01T2 

'■****/0AT2 

*/0AT2 

*/0AT2 

*/DAr2 

*/0AT2 

'*«*VDAT2 

OaT2 

0AT2 

0AT2 

DflT2 

0AT2 

DAT2 

0AT2 

*/0AT2 

0AT2 

0AT2 

0AT2 

0AT2 

CAT2 

DAT2 

DAT2 

DAT? 

DAT2 

DAT? 

0AT2 

0AT2 

CAT2 

0AT2 

•/0ST2 



KOLMOGOROV-SMIRNOV TEST KOLM 
Problem Description 

This program is concerned with the problem of 
determining from what probability density function 
a particular sample is drawn, or whether two 
different samples were drawn from the same 
population. In other words, in the one -sample 
case, the actual distribution function of the sample 
is compared with one or more theoretical distribu- 
tion functions, which may be normal, and/or 
exponential, and/or Cauchy, and/or uniform, and/ 
or a user-specified distribution. In the two-sample 
case, the two sample (actual) distribution functions 
making up the pair are compared with one another. 

From the above comparisons, a statistic is 
derived. In the one-sample case, this statistic 
evaluates the probability that the statistic will be as 
great as or greater than its current value, if the 
hypothesis that the accua/ /dample) and the theoreti- 
cal distribution functions are equal is correct. In 
other words, if the probability is determined to be 
0.40, for example, rejecting the hypothesis of 
equality of the distribution ! sections will be an in- 
correct action 40 times out of 100. Similarly, in 
the two-sample case, the hypothesis ;>;-'ng tested is 
the equality of the two actual (sample) di. tribution 
functions. 

This probability is calculated using asymptotic 
formulae. This means that the sample sizes in- 
volved should be large. Sizes greater than 100 are 
suggested by the literature. In this connection, the 
remarks given under subroutine SMIR should be 
considered. 



Program 

Description 

This program consists of the main routine KOLM, 
and four subroutines from the Scientific Subroutine 
Package: KLMO, KLM2, SMIR, and NDTR, 

Capacity 

This program allows up to two samples,' each with 
500 or fewer observations to be examined. If the 
user desires to modify this program to handle more 
observations, the instructions given below under 
"Program Modification" should be followed. 

Input 

Each job consists of two control cards and the data 
cards ( 1-3 below) . 

1. Job control card (minus signs in cc 1-4) 

2. Program control card. Each job requires 
one program control card, defined below: 



Columns 



1 - 20 



Contents 



Title (alphameric) 



21 



22 



1 — one-sample test 

2 — two-sample test 
Leave blank for one- 
sample test. 

— Read both samples 
(two-sample tests). 

1 — Read only one 
sample and compare 
it with the first 
sample read on pre- 
ceding job. 

— Do not print the 
sample (s). 

1 — Print the sorted 
sample (s). 

(F10.3, ten per line) 
(The rest of this control card pertains 
sample test. ) 



For Sample 
Problems 

Uniform test 
(Job 1) 
Uniform- 
Gauss Test 
(job 2) 

1 (job 1) 

2 Oob 2) 

(job 1) 

1 (job 2) 



23 



aob 1) 

1 (job 2) 

to a one- 
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Columns Contents 

24 — Do not compare 

with normal pdf . 
1 — Compare with 
normal pdf. 
25-29 u — mean of the normal 

pdf 
30-34 s — standard deviation 

of the normal pdf 
35 — Do not compare 

with exponential pdf. 
1 — Compare with 
exponential pdf. 
36-40 u — mean of the 

exponential pdf 
41-45 s — standard devia- 

tion of the exponential 
pdf 
46 — Do not compare 

with Cauchy pdf. 
1 — Compare with 
Cauchy pdf. 
47-51 u — median of the 

Cauchy pdf 
52-56 s — u-s is the first 

quartile of the 
Cauchy pdf 
57 — Do not compare 

with uniform pdf. 
1 — Compare with 
uniform pdf. 
58-62 u — left endpoint 

of the uniform pdf 
63-67 s — right endpoint of 

uniform pdf 
68 — Do not compare 

with user's pdf. 
1 — Compare with 
user-specified pdf. 
69 - 73 u\ Parameters for 

74 - 78 sj user-specified pdf 

u and s are described 
fully in "Description of 
Parameters" under 
subroutine KLMO, and 
are read usii^ Format 
F(5,0); decimal points 
wUl override the 
format specification. 



For Sample 
Problems 

1 (job 1) 



0. 5 (job 1) 
0.5 Oob 1) 

1 (job 1) 
0.5 (jobl) 
1. (job 1) 

1 (job 1) 
0. 5 (job 1) 
1. (job 1) 

1 Oob 1) 
Oob 1) 
1. Oob 1) 
Qob 1) 



Oob 1) 
Oob 1) 



3. Data is read into the computer one sample at 
a time. The reading of a sample is terminated by a 
data element of 999999. New samples must begin on 
a new card. Data elements are punched on cards 
using format F(6,0), which assumes twelve 6-column 
fields per card; decimal points on the card override 
the format specification. Since the routines KLMO 
and KLM2 sort the samples, no particular order 
within a sample is necessary. 



Deck Setup 

The deck setup is shown in Figure 32. 




Last problem 



Procedures and main program 



Figure 32. 



Sample 



The listing of input cards for the sample problems 
is shown in Figure 33, 
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VlT.\'lll r, .,, l"lC0C.5C00.51OC0.5CCCC1100C.50CCCll0C0C0000Cl 


10 
20 


0.377 C.26C 0.172 0.668 0.581 C.290 0.514 C.A72 0.204 0.976 0.018 326 


30 


^n? ^!;' ^"° <=•"* *=*'«^ °-"5 0.737 0.^27 0.931 0.745 0.092 cAii 


40 


0.231 C.8C6 0.753 0.263 0.604 0.458 0.508 C.S28 C.994 C.608 0.702 0.743 


50 
60 


0.005 C.S51 0.e64 0.425 C.57C C.596 0.444 0.3C2 C.817 0.183 0.746 0.833 


0,282 C.2C1 C.662 0.167 C.C43 C.750 0.117 0.953 0.665 0.4U 477 164 


70 


n'fef ^'*'P '^•^*' *^'*^** °*^^^ ^*"^ *^*^«3 0-"2 C.540 0.301 0.953 o!o06 


90 


0.458 0.6« 0.041 0.995 0.6C4 0.666 0.561 0.367 0.156 0.630 0.377 0.569 




0.13^ C.536 C.963 C.956 C.C68 0.801 0.199 0.965 0.113 0.816 0.880 931 


100 


C.67C 0.64C 0.805 0.C73 0.196 C.516 0.336 0.371 0.197 0.843 0.288 0.139 


110 


0.24^ 0.2CC 0.025 0.349 C.87C C.C80 0.652 0.190 C.275 0.939 0.161 0.514 


120 


0.636 C.19C 0.416 0.786 C.973 0.767 0.845 0.168 C.40C 0.888 0.726 O.ltt 


130 


0.652 0.632 0.923 0.644 C.761 0.969 0.965 0.C73 C.751 0.851 0.340 0-383 


140 


0.243 C.CCe C.e6C C.C93 C.616 0.056 0.C06 0.515 0-033 0.565 0.093 C-470 


150 


C.982 0.666 0.154 C.933 C.215 0.890 0.409 C.441 0.963 C.810 0.195 0.876 


160 


^!^i S-Mi °-"^ •=•"* °''^^ °-81° C.C63 0.202 0.469 0.996 0.752 0.545 


170 


0-503 0-117 C.17C 0-972 C.298 0.C42 0.574 C.C65 0.225 0.766 0.57C 0.520 


180 


0.996 C.292 C-79C C.IU C.556 0.337 0.C12 0.C42 C.143 0.482 0.607 0-302 


190 


0.353 0.397 0.206 C.662 0.119 0.754 0.450 C.918 C.453 0.463 0.699 022 


200 


0.842 C.E59 0.577 C.725 C.163 C.450 0.232 0.349 COCO 0.864 0.181 311 


210 


0.236 C.622 0.607 0.C42 C.787 C.346 0.C06 0.9C4 C.365 0.C53 0.037 o!745 


220 


0.136 0.113 0.455 C.7C8 C.156 0.572 0.012 C.928 C.455 C.381 0.193 0.728 


230 


n'tlt n'V'°. °'*" °'^" '^•^**^ ^•'°^ '^•2** "^-"^ C.181 0.203 0.588 0.701 


240 


0.909 0.146 0.7Ce C.9C9 0.C88 0.345 0.277 0.556 C.840 0.033 0.639 0.539 


250 


0.482 0.041 C.907 0.077 0.299 0.C97 0.892 0.478 C-835 7C7 733 079 


260 


0.581 C.224 C.112 0.659 0.945 0.741 0.94C C.969 C.360 0.434 0)365 0.*285 


270 


0.422 0.967 0.005 0.326 0.924 0.595 C.253 C.157 0.668 0.594 0.554 0.984 


280 


0.913 0.622 0.516 C.502 0.364 C.667 0.724 C.344 0.546 C.178 0.151 0.302 


290 


0.457 C.C21 0.019 0.923 0.365 0.682 C.OIC C.121 0.637 0.734 0.671 0.416 


300 


0.459 0.CC9 0.919 0.434 C.331 0.C79 0.50C C.284 C.209 0.694 0.283 0.454 


310 


0.176 0.978 0.272 0.827 0.512 0.634 0.195 C.462 C.C19 0.956 0.560 0.761 


320 


0.524 C.294 0.C47 0.634 0.362 0.591 0.103 C.3C3 0.889 0.607 0.636 0.367 


330 


C.463 C.471 0.664 0.742 C.476 C.178 0.785 C.113 0.610 0.646 0.390 0.520 


340 


C.611 C-986 0.431 C.699 0.312 0.580 0.672 0.810 C.814 0.597 0.256 C.164 


350 


0.679 0.6C3 0.504 C.595 0.C33 0.846 0.783 C.C79 0.430 C.866 0.343 0.244 


360 


0.376 C.C62 C.99C 0.381 C.371 0.801 0.467 C.592 C.348 0.759 0.422 697 


370 


^^!f n*2?^ °*"* ^-^^^ '=*^" '=*«'*2 0.793 C.I77 0.926 0.964 0.450 0.022 


380 


O.Ce5 0.311 0.102 0.616 C.973 0.494 0.206 0.6C3 C.948 0.462 0.242 0.287 


390 


0.546 0.698 0.269 0.339 0.607 0.594 0.102 0.266 0.677 0.668 913 462 


400 


0.562 C.2C7 0.186 C.264 0.895 C.991 0.893 C.442 C.615 C.7C9 0.722 c!950 


410 


0.206 0.696 0.304 0.557 0.605 0.617 0.256 0.984 0-595 0.715 0.936 0.178 


420 


0.141 0.153 0.654 0.544 C.376 C.363 0.793 C.492 C.812 0.447 0.376 0-231 


4 30 


0.644 0.263 0.785 0.241 C.982 0.629999999 


440 
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450 
460 

4 70 


-0.263 0.916 0.776 C.69C C.910 0.506 C.616 C.348 C. 659-0. 301 0.630-0.397 


0.515 C.227 1.253 0.421 0.499 0.288 1.189-C.264 0.099 0.051 0.411 0-951 


&80 


0.273 C.1E4 0.861 C.937 C.44t 0.702 1.451 C.C35 C.515 C.770 0.559 1.053 


490 


'Is'lV-. r'^^^ °'"^ ^•^''° ^•''^^ ^-^^^ l-l^<= °-*33 C.573 0.374 1.317 1.255 


500 


0.547 1.145 0.667-0.077 0.422-0. 159-0.037 C.C88 0.406 0.649 0.898 0.37? 


510 


-0.324 0.026 0.632 0.365 0.375 0.694-0.206 C. 126-0.381 1 . U9 0.983 1.184 


520 


"a'S}] ^'I'.l S-f * ^-"^ '^-3* ^•'^^*' ^-^^ >-"^ 0-'«2 0-1^8 0.222 0.445 


530 


0.714 C.6C7 0.374 C.341 C.79C 0.302 1,075 C.2C4 0.436 0.887 0.234 874 


540 


0.046 0.938 0.733-0. 340-0. C12 0.497 0.416 0.640 C.091 0.578 0.606-0.340 


550 


0.656 0.660 0.584 C.837 0.454 0.695 0.606 0.053-0.276 1.600 1.394-0 038 


560 


1.173 C.7£2 0.642 0.185-C.C23 0.037 0.508 C. 313-0. 718-0.249 0,124-0.096 


570 


-0.299 0.196 1.086 0.487 0.317 0.635 0.462 0.559 C.181 1.799 0.287 0.583 


580 


0.313 0.367 1.C67 0.996 0.702 0.066-0.227 0.198 0.305-0.021 0.849 1.063 


590 


1.049 0.226-0.297 C.930 0.626 0.884 1.217-0.391 0.007-0.004 1.238 0.376 


600 


0.418 1.0.5 C. 083-0. 020 0.362 0.601 0.037 0.634 0.109 0.524 1.356 1.024 




-0.602 0.763 1.261 0. 302-0. C63 0.704 0.446-C.410 0.401 0.704 1.070-0.023 


620 


-°'IV, l-f!!-0-'"-<=-'^'* 1-15* 0.648 0.624 0.257 0.643 0.147 C.719 0.174 


630 


"nifr^^" °-"^ *^-"° C. 592-0. 144 0.222 0.368 0.563 0.933 1.108 1.022 


640 


0,816 C.6E6 0.683 0.514 0.284-0.280 0.356 1.2C3-0.643 0.110 0.012 0.'99 


650 


^f?1 ^t^^ °-"* °-^^° ^•'"'^ °-^" 1-120 C.391 0.191 0.196 1.176 0.149 


660 


0.512 1.132 C.916 C.638 C.445 1.330 0.563 C.610 C.699 0.675 0.310 0.586 


670 


0.446-0.475 0.317 0.656 C.839-0:297 0.214 C.985 0.484 1.004 1.596 0.494 


680 


0.467 1.188 0-536 0.381 1.339-0,011 0.C64 C.113 0.619 0.604 0.687 0.622 


690 


^n' ^?" °-"^ 1-^*^ ■=•^29 0.422 0.076 0.C57 0.143 0.868-0.302 0.693 


700 


^!^ I'llt O-lie-C--^" <:.663 0.7C8 0.685 C.850 0.566 0.657 1.217 0.394 


710 


0.643-C.C55-C.COO 0.861 1.163 0.520 0.787 1.493 1.366 C.801 0.301 1.384 


720 


-0.541 1.176 0.236 0.675 1.119 l.COO 0.250 0.457-C.OlC 0.098 0.975 238 


7 30 


0.686 0.764 0.007 0.697 C.789 0.259 0.414 0.660 0.852 0.315 C.231 0.203 


740 


1.394 0.131 0.963 C,699 C.404-0.124 0.583 C.071 1.838-0.313-0.467 C.191 


750 


0.125 1.67C 0.224 0.4C0 0.65E 0.900 1.034 0.CC5 0.801 0.920-0.168 0.786 


760 


n'^.ll I'V.l ^'^''^ °*^^^ C. 718-0. 152 0.009 1.329 0.562 0.687 0.968 0.490 


770 


0.16C 0.177-0.025 1.125 0.217 1.206 1.221-0.145-0.088 0.629-0.131 0.272 


780 


0.388 0.772 1.C46-C.067 C.76C 0.428 0.852 C.667 C.610 0.359 1.352 0.571 


790 


-0.011-0.205 1.084 C.CC9 0.917 0.436 1.C50 0.616 0.864 0.954-0.275 1.295 


800 


0.346-1.018 1.049 0.417 1.23C 1.127 1.435 C. 823-0.069 0.464 1.261-0.179 


810 


0.812 0.527 0.875 C.190 0.707 0.657 C.C94 0.176 C.916 0.406 0.204 0.494 


820 


\']V. ^i-^ °*'^**^ C. 628-0. 174 0.457 0.584 0.832-0.026 1.265-0.232-0.373 


830 


"^iIf ^.'VA °-"^ '^•-" °-"5 1.226^0.072 0.920 1.2C7-0.003 0.632 0.00^ 


840 


0.951 C.3C7 0.798 1.479 0.196 1.058 0.873 COCO 0.524 0.501 0.373 0.954 


850 


-0.C72 0.988 0.351 0.053 0,248 0.430-0.379 0.533 0.686 0.524 0.447 1 376 


860 


-0.263-0.064 0.301 1.486 0.351 0.80fr-0.374 0.735 0.958-0.262 0.332 0^963 


870 

380 


Figure 33. 





Output 

Description 

The output from the program KOLM gives the 
statistics and probability statements described be- 
low, and in addition identifies the distribution func- 
tions beii^ considered. Sorted samples are print- 
ed on option. 

The following items are produced as output: 

1. Z score, where 

z = -/ii Djj for the one-sample test; n is 
the sample size, and D^ is the maximum 
difference between the empirical distribu- 
tion function and the theoretical distribu- 
tion function. 

z "Viii+n ^m n ^°^ ^^ two-sample test; 

m is the size of the second sample; n is 
the size of the first sample; D is the 
maximum difference between the 'two em- 
pirical distribution functions. 

2. The probability of incorrectly rejecting the 
hypothesis of equality of distribution functions. 

Sample 

Sample output is shown in Figure 34. 



ur^TFC^v TEST 



1 SAMPLE TEST Wis REQUESTED. 



THF SIZE OF Sfl'IPLE 1 IS A98. 



THE UVPOTHESIS TH«T THE SIMPLE IS FROM «(NI NO»«»L 

WITH "f^m C.5C^? aNO VAkIAMCE C.25C0 

CAN RE REJECTED WITH PROBARlLITY C.CCC DF fEING INCORRECT. THE STATISTIC 2 

IS 3.5839E*CC FOR THIS SAMPLE. "'lain. t 



DISTRIBUTION 



THE HYPOTHESIS THAT 
WITH MEAN O.S 

^f •^n?^f'^J^°=!'"^ PRTRABILITY C.CCC OF » EI Ng" I NCORR ECT . THE STATISTIC Z 

1^ "-yu3Jt:*C0 ^r", THIS Si'^PL'-. 



SAMPLE IS FROM AINI EXPONENTIAL DISTRIBUTION 

ITH MEAN O.SCC" AND VA°UNCE l.CCOO 



IHE HYPOTHESIS TH«T THE SAMPLE IS FROM AIM CAU^HY 

WITH MEAN C.5C0C AND FIRST QUARTILF -0.500C 

CA>: ?E REJECTED WITH PB^SABlLITY C.CCC np BEING INCORRECT. 
IS 7.B873E*0C FOR THIS SAMPLE. 



DISTRIBUTION 



THE STATISTIC Z 



IvVurT^LV^ '"" ""^ """'-'' ■' f""^" """ UNIFORM DISTRIBUTION 

I> THE IMTERVAL O.OOCC TO l.CCCC INCLUSIVE 

CAr; ?E REJECTED wyn PRCBISILITY C.oe? OF REING INCORRECT. THE STATISTIC I 
i^ 4.4444E — C1 rO^ THIS S'^MPLd. 



T'^E JCB WITH TITLF UNIFORM tp 



Wis CCMPLETEO. 



Figure 34, 
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UNIFCftM-GAUSS TEST 
a 2 SAMPLE TEST WAS REQUESTED, 
THE SIZE OF SAMPLE 2 IS 492. 



sckted sample 


ONE AS 


FOLLOWS 
















o.occ 


C.G05 


0.005 


G.CC6 


0.006 


0.006 


0.008 


0.009 


O.OIO 


0.012 


o.ei2 


0.018 


0.019 


0.C19 


0.021 


0.022 


0.022 


0.025 


0.029 


0,033 


C.033 


0.C33 


0.C37 


0.C41 


0.041 


0.042 


0.042 


0.042 


0.043 


0.047 


0.C53 


0.054 


0.055 


G.058 


0.062 


0.065 


0.068 


0.073 


0.073 


0.077 


C.079 


0.079 


0.030 


G.083 


C.083 


0,085 


0.088 


0.092 


0.093 


0.093 


C.097 


O.C9ft 


0.102 


0.1C2 


0,103 


0.111 


0.112 


0,113 


0.113 


0.113 


O.llT 


0.117 


0.119 


0.121 


0.123 


0.136 


0.139 


0.139 


0.141 


0,143 


O.l'.fl 


0.151 


0,153 


0,154 


0.156 


0.157 


0.158 


0.161 


0.163 


0.164 


■■.164 


0.167 


0.168 


0.170 


0.172 


0,177 


0.178 


0,178 


0.178 


0.178 


'".IBl 


O.lfll 


C.183 


0.188 


0,19C 


0.190 


0.193 


0.195 


0.195 


0.196 


■* .157 


0.199 


0.200 


0.201 


0.202 


0t2P3 


0.204 


0.206 


0,207 


0.208 


0.2C8 


0.209 


0.215 


0.22C 


0.224 


0.225 


0.228 


0.231 


0,231 


0,232 


C.ZSh 


0,2 42 


0.242 


C.243 


0.244 


0.253 


0.256 


0,256 


0.260 


0,263 


0.263 


0.264 


C.264 


0.266 


0.268 


0.269 


0.272 


C.275 


0.277 


0.282 


C .283 


0.284 


0.285 


0.287 


0.238 


0.288 


0.290 


0.292 


0.294 


0.298 


0.?9<i 


0.301 


0.302 


0.302 


0.302 


C.303 


0.304 


0.311 


0.311 


0.312 


r .326 


0.328 


0.331 


C.336 


0.3 37 


0.339 


0.340 


0.341 


0,343 


0.344 


C.345 


0.348 


0,348 


0.349 


0.349 


G.353 


0.360 


0.363 


0.364 


0.365 


. 365 


0.365 


0.365 


0.367 


C.367 


0.571 


0.371 


0.376 


0,375 


0.376 


':.377 


0.577 


0.381 


G.381 


0.3 82 


C.383 


0.388 


0.390 


0,397 


0.400 


C.4C9 


0.411 


0.416 


0.416 


0.422 


0.422 


0,425 


0.427 


0.430 


0.431 


'".434 


0.4 34 


0.441 


0.442 


0.444 


0,447 


0.450 


0.450 


0.450 


0.453 


C.454 


0.455 


0,455 


0.457 


C,458 


0.458 


0.459 


0.462 


0.462 


0.462 


C.463 


C.463 


0.467 


0.469 


0.470 


0.471 


0.472 


0,476 


0.477 


0.478 


0.482 


0.482 


0.492 


0.4 94 


C.500 


0.501 


0.501 


C.502 


0.503 


0.504 


G.5C8 


0,512 


0.514 


0.514 


0.515 


0.516 


0.516 


0.518 


0,518 


0.520 


C.5 2C 


C.524 


0.531 


C.536 


0.539 


C.540 


0,544 


0.545 


0.546 


0,546 


C.5'i4 


C.5S5 


C.556 


0,556 


0.557 


0.560 


0.561 


0.562 


0.565 


0.570 


C.57C 


0.572 


C.574 


0.577 


0.580 


0.581 


0.581 


0.585 


0,588 


0.589 


C.591 


C.5'='Z 


0.594 


0.594 


0.595 


C.595 


0.595 


0.596 


0.597 


0.603 


i:.6C4 


0,605 


C.607 


0.607 


0,607 


0.607 


0.608 


0.610 


0.611 


0.615 


0.617 


0.6 22 


0.622 


0,624 


0,629 


. 6 30 


0,632 


0.634 


0,634 


0.636 


%6 37 


C.63'1 


0.639 


G,64C 


0,644 


, 646 


0.652 


0.652 


0.654 


0.657 


0.659 


C.662 


0.662 


0,664 


0.664 


0.665 


0.666 


0.666 


0.667 


0.668 


0.6 68 


0.67G 


C.671 


0.672 


0.677 


0,679 


0.683 


0.686 


0.688 


0.692 


C.694 


0.694 


0.696 


0.697 


0.698 


0.699 


0.699 


0.701 


0.702 


0.707 


0.708 


0,708 


0.709 


0.715 


0.722 


C.724 


0,725 


0.726 


0.728 


0.733 


0.734 


0.737 


.74 1 


0.742 


0.743 


0,745 


0.745 


0.746 


0.750 


0.751 


0.752 


C.753 


0.754 


0.759 


C.761 


C.761 


0.766 


0.767 


0.783 


0.785 


0.785 


0.786 


0.787 


C.79C 


0.793 


0.793 


0.795 


0,801 


0.8C1 


0.803 


0.8G4 


G.e05 


0.806 


0.810 


0.810 


0.810 


0.812 


0.814 


0.816 


0.816 


0.816 


0.817 


0.827 


0.829 


0.633 


C.835 


0.836 


0.837 


0.840 


0.842 


. 842 


0.3 43 


C.843 


0.844 


0.845 


0.846 


0.851 


0.859 


0,860 


C.860 


-" .864 


G.867 


0.866 


C.870 


C.87C 


C.876 


0.880 


0,882 


0,882 


0.888 


C.889 


0.8^0 


C.892 


0.893 


C.895 


0.904 


0.907 


0.909 


0.909 


0.913 


C.913 


0.91=^ 


C,919 


0.923 


C.923 


0.924 


0.926 


0.928 


0,928 


0.931 


-.9 31 


'^.933 


0.936 


G.939 


G.940 


0,945 


0,948 


0,950 


0.951 


0.95? 


0.953 


0,956 


C,95^ 


G.962 


0.963 


C.963 


0.964 


0.965 


C.967 


0.969 


0.969 


0.972 


C.973 


C.973 


0.976 


C.978 


0.982 


0.982 


0.984 


0,984 


C.985 


0.988 


C.99C 


C.991 


0.994 


0.995 


0.996 


0.996 






SORTED SAMPLE TWO AS 


FOLLOMS 














-0.475 


-1.157 


-1.018 


-0.737 


-0.718 


-0.643 


-G.602 


-C.552 


-0.541 


-0,476 


-0 .469 


-0.467 


-C.41C 


-0.397 


-0.391 


-C.?81 


-0.379 


-0.374 


-0,373 


-0.340 


-0.340 


-0.324 


-0.313 


-0.302 


-0.301 


-C.299 


-0.297 


-0,297 


-0.283 


-0.280 


-0.276 


-0.2 75 


-C.264 


-0.263 


-C.262 


-C,249 


-0.232 


-0.227 


-0,206 


-0.205 


-0.188 


-0.183 


-0,179 


-C . 1 74 


-0.172 


-0.159 


-0.152 


-C.145 


-C.144 


-C.131 


-0.124 


-0.C96 


-0.C88 


-0.C77 


-0.072 


-0.C72 


-C.C69 


-0.067 


-0.064 


-0.064 


-0.063 


-0,055 


-CO 38 


-C,C37 


-0.026 


-0.0 25 


-0.023 


-0.023 


-0.C21 


-0.020 


-0.C12 


-O.Cll 


-C.Cll 


-O.Cll 


-O.CIC 


-COO^ 


-0,C03 


0.000 


C.004 


0.005 


0.007 


0.C07 


0.009 


C.0C9 


C.012 


0.025 


0.035 


0,035 


0,C37 


0.C37 


0.048 


0.C51 


0.053 


0.C53 


0.057 


0.C60 


0.C64 


0.068 


C.071 


0,078 


0.083 


0.088 


0.091 


C.C94 


0.098 


0.099 


0.102 


0.109 


Clio 


0.113 


0.118 


0.124 


0.125 


0.126 


0.131 


0,133 


0.143 


0.147 


0,149 


0.154 


0.160 


0.174 


0.176 


C.177 


0.181 


0,185 


0,190 


0,191 


C.191 


0.196 


0.196 


0.196 


0.196 


C.198 


C.203 


0.203 


0.204 


0.204 


C.214 


0.217 


0.222 


0.222 


C.224 


0.226 


0.227 


C.231 


G.234 


C.236 


0,248 


C.25C 


C.257 


0.259 


C.266 


C.272 


0,273 


0.284 


0.287 


0.288 


0.288 


0.297 


0.3CI 


0.3C1 


C.302 


0.302 


C.303 


C.305 


C.307 


0.31C 


0.313 


0.313 


0.315 


0.317 


0,317 


C.332 


0.341 


C.346 


0.348 


0.351 


0.351 


C.358 


0.359 


0.362 


0.365 


G,372 


0.373 


0.37* 


0.374 


0.375 


0.376 


0.378 


C.331 


0.387 


C.387 


C.3 68 


C.388 


0.291 


0.394 


0.399 


C.40C 


0.400 


0.401 


0.4C4 


0.406 


0.406 


C.411 


C.414 


C.417 


C.418 


0.416 


0.421 


0.422 


0,422 


G.42fl 


0,430 


0.433 


C.436 


0.438 


0.445 


0,445 


0.446 


0.446 


0.447 


0.448 


0.454 


0.457 


0.457 


0.46C 


C.1.62 


C.464 


0.467 


0.484 


C.487 


G.49C 


C.494 


C.494 


C.407 


0.499 


0.501 


0.5C6 


0.5C8 


0.512 


0.514 


0.515 


0,515 


C.520 


0,524 


0,524 


0,5 24 


0,533 


0,533 


0.536 


0.536 


0.537 


0.547 


0.559 


C.559 


0.562 


C.563 


0.563 


0.566 


0.571 


C,573 


C.576 


G.583 


0.563 


C.533 


0.584 


C.584 


0.586 


C.592 


0.6C1 


0.6G4 


0.606 


C.6G6 


0.6C7 


0.6 10 


0.61C 


C.616 


0.619 


G.622 


0.624 


0.629 


C.63f^ 


C.632 


0.632 


0.6 33 


0,634 


0,635 


C.642 


0,643 


C.643 


0.648 


C.653 


C.650 


0.657 


0.658 


0.659 


0.660 


C.663 


0,667 


0.673 


0.675 


G.675 


0.680 


0.683 


C.6S5 


0.686 


0.686 


0.687 


0.687 


0.688 


0.690 


0.693 


0,694 


0.695 


G.697 


0,699 


C.699 


0.702 


0.7C2 


0.704 


C.7C4 


0.7C7 


0.708 


0.714 


0.716 


0.719 


0.733 


C.735 


0,74C 


0.743 


0,760 


C.761 


0,762 


0.763 


0.764 


0.770 


0.772 


0,776 


0.782 


0.786 


0.787 


0.789 


0.790 


C.796 


■:.6Gl 


0.801 


0.806 


C.812 


0.816 


0.818 


0.823 


0,828 


0.828 


0.829 


0.P32 


0.837 


0.838 


0.839 


0.840 


0.849 


0.849 


0.850 


0.852 


C.852 


C.&57 


0.858 


0.861 


C.867 


0,868 


0.873 


0.874 


0,875 


0.875 


0,88C 


0.881 


0.884 


0.884 


0.887 


0.698 


0.899 


0.9CC 


0.9C2 


0.910 


0.913 


C.916 


C.916 


0.916 


C.91? 


C.920 


0.92C 


0.930 


0.933 


0.936 


0,937 


0.O36 


0.951 


0.951 


0.9 54 


0.954 


0.958 


0.963 


0,963 


0.968 


0.975 


0.':'83 


0.985 


0.988 


C.989 


0.994 


0.996 


1.000 


1.C04 


1.C22 


1.024 


1.034 


1.C35 


1.046 


1.C49 


1.049 


1.050 


1,053 


1.C58 


1.G63 


1.067 


1.070 


1,C75 


1.G75 


1.C84 


1.086 


1.087 


1.1C8 


l.ilC 


1.116 


1.119 


1.120 


1,125 


1.127 


1,132 


1,145 


1 .149 


1.156 


1,163 


1.173 


1.176 


1.176 


1.177 


1,184 


1,188 


1,189 


1.190 


1,203 


1.20 6 


1.207 


1.217 


1.217 


1.221 


1.2 26 


1.230 


1.238 


1.243 


1.253 


1.255 


1.261 


1.261 


1.265 


1.270 


1,295 


1.313 


1.317 


1.329 


1.330 


1.339 


1.352 


1,356 


1.366 


1.376 


1.384 


1.394 


1.394 


1.435 


1.451 


1.479 


1.486 


1.493 


1.598 


1.6C0 


1.644 


1,67C 


1.7C9 


1.799 


1.838 



















THE HYPOTHESIS THAT THE TWO SAMPLES AFE PCCM THE SAM? POPULATION CAN BE REJECTED WITH (ASYMPTOTIC) 
PROSABILITV 3F 8E INC. INCORRECT OF O.GCC. TME STATISTIC I IS 2.59C0E+00 FOR THESE SAMPLES. 



THE JOa WITH TITLE UM IFOfiM-GAUSS TEST WAS CHMPLETED. 
END OF SAMPLE PROGRAM 



Figure 34. (Continued) 
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Program Modifications 



Operating Instructions 



1. Program capacity may be increased or de- 
creased by making changes in the allocation state- 
ments. If this is done, the limits on the DO state- 
ments may require modification, as will be the 
case if data formats require changing, it is also 
possible that output formats may require changes. 

2. Any modifications to the subroutine KLMO in 
terms of added continuous pdf's should be reflected 
in the program KOLM. It may be necessary to: 

a. Modify the declaration of DIST (5, 3), 
which contains the switches calling on pdf's 
and also contains the parameters u and s 
used by KLMO. 

b. Modify the pdf titlii^ cards numbered 
KOLM 230 through 270. 

c. Modify the section of the program from 
S70 through SIOO to reflect changes a and 
b above. These statements call KLMO to 
perform tests and output results. 

3. List of variables in KOLM, and their us^e: 



DAS2 
DIST- 



ERROR 

I- 

IFL - 
lES- 

10- 

m - 

IS- 

M - 
N- 
P - 

S2 - 

TITl - 
TITLE - 
X- 
Y - 
Z - 



Temporary vector used in readitig 
samples 

Job Control Card name ( ) 

5 by 3 matrix. The five elements in 
column 1 are switches that allow the 
5 pdf's to be used in one-sample tests. 
Columns 2 and 3 contain the parame- 
ters u and s for the associated test. 
Error (in using KLMO, used for 
skipping the test concerned) 
Counter used to print correct pdf name 
for pdf used in the test 
Error indicator (job deck error) 
Error (in using KLMO, used for error 
message) 

Switch (used for printii^ samples) 
Number of samples to be read in cur- 
rent job 

Number of samples to be used in cur- 
rent job (1 or 2) 
Size of the second sample 
Size of first sample 
Probability of beii^ incorrect if hy- 
pothesis is rejected 
Temporary storage for u and s out- 
put 

Current pdf names 
Job title 
Sample 1 
Sample 2 
Z statistic from KLMO or KLM2 



This sample program is a standard PL/l program 
and needs no special operating instructions. Data 
set SYSIN is used for input; data set SYSPRINT, 
for output. 

Error Messages 

The following error conditions will result in mes- 
sages, followed by the action specified: 

1. Neither a one-nor two-sample test is re- 
quested, or the size of either sample is larger 
than 500 — CC.21, CONTROL CARD, INCORRECT, 
OR SAMPLE SIZE TOO LARGE. JOB IGNORED. 
Action: Cards are read until a new job control 
card is found, or until the hopper is empty. 

2. Sample size is less than 100 (not an error) — 
NOTE THE REMARKS CONCERNING ASYMPTOTIC 
RESULTS AND SAMPLE SIZE IN SUBROUTINE 
SMIR. Action: none. Job continues. 

3. The requirement of subroutine KLMO that 
certain parameters be nonzero or positive is vio- 
lated ~ AT LEAST ONE (S) ENTRY PARAMETER 
FOR THE SUBROUTINE KLMO WAS INCORRECT. 
THE TEST FOR THE ASSOCIATED CONTINUOUS 
PDF WAS IGNORED. Action: All tests are made 
for cases where the parameter s was correct. 

4. A case in which an error requires abortii^ 
the job, and the succeedii^ job in the job stack re- 
quests a two-sample test where the second sample 
is to be compared with a (first) sample, which was 
read on the previous job ~ THIS JOB CALLS FOR 
THE USE OF A PREVIOUSLY READ SAMPLE, AND 
THE PREVIOUS JOB WAS IGNORED BECAUSE OF 
ERRORS. JOB IGNORED. Action: Cards are read 
until a new job control card is found, or until the 
hopper is empty. 

5. The job control card preceding a job is not 
there or is incorrect ~ FIRST CARD IN JOB DECK 
(JOB CONTROL CARD) IS INCORRECT. Action: 
Cards are read until a new job control card is 
found, or until the hopper is empty. 

Timing 

The execution time of this program on a ^stem /360 
Model 40, using a 2540 Card Reader as input and a 
1403 Printer, Model Nl, as output, is 35 seconds 
for job 1 and 55 seconds for job 2. 
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KOLH 

/« 



KOLH 10 



/• THE PURPOSE OF THIS ROUTINE IS TO: 

(1) READ THE CONTROL CARD FOR A ONE OR TWO SAMPLE TEST. 
(21 READ THE SAMPLE DATA AND DETERMINE THE SAMPLE SIZES. 
131 CALL SHIR, KLMO, AND KLM2 FOR CALCULATION OF 

PROBABILITIES. 
(41 PRINT RESULTS. 



/• 



*/KOLH *0 

♦/KOLH 50 

♦/KOLH 60 

♦/KOLM 70 

•/KOLH 80 

♦/KOLH 90 

♦/KOLH 100 

/♦••♦♦♦♦♦♦♦•♦♦♦♦•♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦********»******»***************/'*0'-M 1 10 

PROCEDURE OPTIONS (MAIN)*. 

DECLARE 

IDASHiDASZ) CHARACTER {4>» 

(ItJ.K,L,HtN,IS,IRfI0.1FL.E) FIXED BINARY* 
(DISTt5,3l.0ll2»»X(501l,Y«501»,PfZtS2» FLOAT BINARY, 
TITLE CHARACTER (20), 
TITH51 CHARACTER (161, 
lES CHARACTER (1>, 
ERROR EXTERNAL CHARACTER (1).. 
ON ENDFILE(SYSIN> GO TO S.700t, 



SH 



IFL =0, 


, 


DASH =•- 


• ,, 


TITIII) 


NORMAL '.. 


TIT1I2) 


«• EXPONENTIAL 


TITIO) 


= • CAUCHY S. 


TITKAI 


=t UNIFORM ',. 


TIT1151 


-• USER-SPECIFIED •,. 


GET E0IT(DAS2,EMA(4),X175),F11)) 


IF 0ASH=> 


DAS2 


THEN 





/♦ INITIALIZE NAMES 

/♦ AND JOB CONTROL CARD 



/« READ TITLE AND 

/♦ PROGRAM PARAMETERS 



KOLH 120 
KOLH 130 
KOLM 140 
KOLM 150 
KOLM 160 
KOLH 170 
KOLM 180 
KOLH 190 
KOLH 200 
KOLH 210 
KOLH 220 
KOLM 230 
♦/KOLM 240 
♦/KOLH 250 
KOLH 260 
KOLH 270 
KOLH 280 
KOLH 290 
KOLM 300 
KOLM 310 
KOLH 320 
♦/KOLM 330 
♦/KOLM 340 

DO,. *^^^^ ^^° 

GET*EDIT(TITLE,IS,IR.IO,DISTI^,*I,E1(A(20I.3 F ( I ) ,5(F( 1 > ,2 FISIKOLH 360 

).X(n,F(l)l,. KOLM 370 

lES ~*0* ,, "^OLH 380 

PUT EDIT iriTLE)(A(20)) PAGE*. XOLH 390 

PUT EDIT (• A',IS,» SAMPLE TEST WAS REQUESTED. M (SKIP (3 ), At 2) , KOLM 400 

F(2),A(27n,. t^OLM 410 

IF SH-0 AND IS-2 AND IR=1 "tOLH 420 

THEN DO,, KOtM 430 

PUT EDITC FIRST JOB REQUIRES PREVIOUS DATA FOR A TWO SAH'KOLH 440 

,'PLE TEST.'MSKIP(3),A(471,A(9M,. KOLM 450 

•tu =1.. KOLM 460 

KOLM 470 

KOLH 480 

KOLM 490 

♦/KOLM 500 

KOLM 510 

KOLM 520 

♦/KOLM 530 

KOLM 540 

KOLH 550 

PUT EDIT! • CC,21 OF THE PROGRAM CONTROL CARD IS INCO'KOLM 560 

,'RRECT. JOB IGNORED. •)(SKIP(3),A(42I,A(20)),. KOLM 570 

KOLM 560 

GET EDIT(DAS2,EMAl4)tX(75),F(l)),. KOLM 590 

IF 0ASH=DAS2 KOLM 600 

THEN DO,. KOLM 610 

IFL =1,. KOLM 620 

GO TO S20,, KOLM 630 

END,. KOLM 640 

ELSE GO TO S40,. KOLH 650 

END*. KOLM 660 

ELSE IF IFL NE KOLM 670 

THEN 00,. /♦ ERROR IN PREVIOUS JOB */KOLM 680 

PUT EDIT!' THIS JOB CALLS FOR THE USE OF A PREVIOUSL' KOLH 690 

.•Y READ SAMPLE, AND THE PREVIOUS JOB HAS IGNORE'KOLM 700 

,•0 BECAUSE OF ERRORS. •* 'JOB IGNORED. • HSKIP( 3 ) * KOLM 710 

A(42),A(46>*A120)*SKIP*A(131),. KOLH 720 

GO TO S40,. KOLM 730 

END*. KOLM 740 

ELSE GO TO S180,. KOLM 750 

END* KOLM 760 

ELSE DO*. KOLH 770 

PUT EDITC FIRST CARD IN JOB DECK (JOB CONTROL CARD) IS INCORR'KOLM 780 

,«ECT,MISKIP(3>,A(52»,A(4I),. KOLM 790 

GO TO S40,. KOLH 800 

END, KOLM 810 

S50.. KOLM 820 

IF IS=2 

THEN GO TO S180,. 
ELSE IF IS GT 2 

THEN GO TO S30,. 
ELSE GO TO S65,. 
S60.. 

IF IS LE 1 /* ONE SAMPLE TEST USING ALL 

THEN DO*. /* DISTRIBUTIONS REQUESTED 

S65.. 

DO 1=1 TO 5 



GO TO S40,. 

END,. 
SW =1,, 
IF IR-0 
THEN IF IS GE 1 

THEN GO TO S140* 

ELSE 



/♦ NO. OF SAMPLES DECISION 



/♦ NO. OF SAMPLES WRONG 



S30. 



S40. 



KOLH 830 

KOLH 840 

KOLH 650 

KOLM 660 

KOLM 870 

KOLM 880 

♦/KOLM 890 

♦/KOLM 900 

KOLH 910 

KOLH 920 

IF DISTdtl) NE KOLM 930 

THEN GO TO S70,. KOLM 940 

END*. KOLH 950 

PUT EDITC NO PDF COMPARISON IS ASKED FOR. • ) ISKIPO ). Al 32) ) . . KOLM 960 

$70 KOLH 970 

DO 1=1 TO 5 ,. KOLM 980 

IF DISTd.lI = 1 KOLM 990 

THEN CALL KLMO(X,N,Z,P, I ,DISTI I ,2) ,DIST ( 1,3) ) , . KOLMIOOO 

IF ERRORs'O* OR ERR0R='3' KOLHIOIO 

THEN KOLM I 020 

DO,. /♦ OUTPUT RESULTS ♦/K0LM1030 

PUT EDITC THE HYPOTHESIS THAT THE SAMPLE IS FROM A(N) •K0LM1040 

,TITl(n,« DISTRIBUTION' ) ( SKIP(31 ,A(47) ,A( 16) ,A( 13) ) KOLH1050 

,, KOLM 1060 

IF I LT 3 /* PREPARE OUTPUT ♦/K0LM1070 

THEN 00,. K0LM1080 

S2 =D1ST(I.3)*^2,. K0LM1090 

PUT EDITC WITH MEAN' ,D1ST 1 1 ,2) , • AND VARI ANCE' ,S2 ) KOLHllOO 

(SKIP,A(10».F(13,4)*A(I3),F(13*4)),. KOLMlllO 

GO TO S60,. K0LM1120 

END,, K0LM1130 

ELSE IF 1=3 K0LM1140 

THEN DO*. K0LM1150 

S2 =D1ST(I,2)-DIST(I,3),. K0LM1160 

PUT EDITC WITH MEAN* *DIST( 1,2) , • AND FIRST ■, K0LM1170 

•QUARTILE'*S2)(SKIP.A(10),F(13,4),A(11), KOLM1180 

A(8),F(13,4)),. K0LM1190 

GO TO S80,, K0LH1200 

END*. K0LM1210 

ELSE IF I LE 4 K0LM1220 

THEN DO,. K0LM1230 

PUT EDITC IN THE INTERVAL' ,DIST( I , 2), ■ T0'K0LM1240 

*DIST(I*3),' INCLUSIVE')(SKIP,A(16», K0LM1250 

F(13.4),A(3),F(13,4),A(10))*. K0LH1260 

580., K0LM1270 



PUT EDITC CAN BE REJECTED WITH PR0BA6ILIT'K0LM1280 
,'Y',P,' OF BEING INCORRECT. THE STAT'K0LM1290 
,MSTIC Z'*' IS'.Z,' FOR THIS SAMPLE. • )K0LH1300 
(SKIP.A(32i,A(IJ*F(6,3)*A(30).AI7),SKIPK0LM1310 
,A(3).E(12,4),A(17)),. K0LM1320 

END, KOLHI330 

GO TO S90r. K0LM1340 

KaLM1350 
=ERR0R,. K0LM1360 

K0LM1370 
K0LH1380 
KOLH1390 
K0LM1400 
/♦ OUTPUT SAMPLE ONE DECISKM ♦/KOLH14I0 
KOLM 1420 



END. 
ELSE lES 
590.. 

END,. 
END*. 
ELSE GO TO SllO 
IF 10 NE 
THEN 00* . 

PUT EDIT C SORTED SAMPLE ONE FOLLOWS' ) (SKIP (3 ) ,A(26) ), . KOLM1430 
PUT EDIT (1X(J) DO J=l TO N))(SKIP,10 (F(10,3))l*, K0LM1440 

END,. K0LH1450 

IF lES ='0' 
THEN 
SIOO.. 

00,. 

IFL =0,. 

PUT EDIT C THE JOB WITH TITLE' ,T ITLE, • WAS COHPLETEO.M 
(SKIP(3),A(22),A(18),A(15n,. 



KOLM 1460 
K0LMI470 
KDLM1480 
KOLM1490 
KaLH1500 
K0LH1510 
KOLM1520 





GO TO 


SIOO 










END.. 










SllO.. 












CALL 


KLH2(X 


.Y,N 


H 


I 


P) 


IF 10=0 










THEN 












S120.. 













IF ERR0R='3' K0LM1530 

THEN PUT EDIT ('NOTE THE REMARKS CONCERNING ASYMPTOTIC RESULTS'K0LM1540 
,' AND SAMPLE SIZE IN SUBROUTINE SHIR.* ) (SKIP(3) .A (46) , K0LHt550 
A(36)).. K0LM1560 

rn in <;io. K0LM1570 

GO TO SIO,. K0LM1580 

ELSE DO,!' K0LM1590 

PUT EDITC AT LEAST ONE (S) ENTRY PARAMETER FOR THE SUBROUTINE'KOLH1600 

,' KLMO HAS INCORRECT. ',• TEST FOR THE ASSOCIATED C0NTINU»K0LH1610 

,'OUS PDF HAS IGNORED. •)(SK!P13),A(521,A(21), SKIP, A(32l, KOLH1620 

.,20)),. K0LH1630 

' KOLM1640 

KGLM1650 

K0LM1660 

/♦ TWO SAHPLE TEST ♦/KOLM1670 

/♦ OUTPUT SAMPLES DECISION ♦/K0LM1680 

KOLM1690 

KDLM1700 

KOLH1710 

PUt'eDITC the hypothesis that the two samples are from THE ', K0LM17Z0 

• SAHE population CAN BE REJECTED WITH ( ASYHPTOTIC) ' , K0LH1730 

• PROBABILITY OF BEING INCORRECT OF'.P,'. THE STATISTIC Z 'KOLM1740 
,MS ',Z,' FOR THESE SAHPLES. • ) (SKIP(3) ,A( 50) . A( 50) ,SKIP, KaLMl750 
AI34),F(6,3),A(18).A(3),EI12*4),A(19)),. KOLM1760 

KaLM1770 

KDLM1780 

K0LM1790 

KOLM 1800 

00,. KOLM1810 

PUTEDIT C SORTED SAMPLE ONE AS FOLLOWS' ) (SKIP( 3), A( 29) ), . KQLMie20 

PUT EDIT ((X(J) 00 J=l TO N))(SKIP,10 F(10*3)),. KOLHlSaO 

PUT EDIT C SORTED SAHPLE TWO AS FOLLOWS' ) {SKIP(3), A( 29) ), . KOLH1840 

PUT EDIT KYIJ) DO J=l TO H))(SKIP,10 F(10,3))*. K0LM1850 

GO TO S120,. K0LM1860 

c«n K0LM1670 

^,40 K0LH1880 

♦/K0LM1890 



60 TO SIOO, 
END, 



ELSE 
S130.. 



=0,, 



/♦ READ FIRST SAHPLE 



DO 1=1 TO 50,. 

GET EOIT((0(K) DO K"l TO 12),E)(I2 F(6),X(7),F( 1) », . 

DO J=l TO 12,. 

IF D(J) = 999999.0 /* CHECK FOR END OF SAMPLE 

THEN GO TO S170,. 

N =N+1). 

IF N GE 501 /♦ MAXIHUM SAHPLE SIZE 

THEN 



DO*. 

PUT EDIT C SAHPLE SIZE IS TOO LARGE. 

(SKIP<3),A(43))*. 
GO TO S40,. 
END, 



KOLH 1900 
K0LH1910 
KOLH1920 

♦/K0LM1930 
KOLM 1940 
K0LMI950 

♦/KOLM 1960 
KOLM I 970 
K0LM1980 
K0LM1990 
JOB IGNORED. 'IKQLMZOOO 
KDLM2010 
K0LH2020 
K0LH2030 



X(N) =0(J)*. 
END*. 
END,. 
S170.. 

PUT EDITC THE SIZE OF SAMPLE 

GO TO S50*. 
S180.. 



/* PLACE SAHPLE IN X 



♦/K0LH2040 

K0LM2050 

KOLM2060 

KOLM2070 

,N, •.')(SKIP(3),A(24)*F(4),AI1)) KGLM2080 

KOLM2090 

K0LM2100 

K0LM2110 

/♦ READ SECOND SAMPLE »/KOLH2120 

d6'i=I to 50,. K0LM2130 

GET ED1T((D(K) do K=1 TO 12)*E)(12 F (6) ,X(7) *FI 1) ) , . K0LM2140 

DO J=l TO 12*. KQLM2150 

IF D(J)=999999.0 /♦ CHECK FOR END OF SAMPLE »/KDLM2160 

THEN GO TO S190,. K0LM2170 

M =H+1,. K0LH2I60 

IF H GE 501 /♦ MAX SIZE OF SAMPLE ♦/K0LH2190 

THEN DO*. K0LM2200 

PUT EDITC SAHPLE SIZE IS TOO LARGE. JOB IGNORED.*) K0LH2210 

(SKIP(3)*A(43I).. K0LH2220 

GO TO S40,. KOLM2230 

END,. K0LH2240 

Y(M) =D(J).. /♦ PLACE SAMPLE IN Y ♦/K0LH2250 

END*. K0LH2260 

END*. K0LM227O 

S190.. K0LM2280 

PUT EDITC THE SIZE OF SAMPLE 2 IS • , M, ' . * ) (SKIP( 3) . A( 24) ,F (4), A{ 1 ) ) K0LM2290 

, KOLM 2 300 

GO TO S60,. K0LM2310 

S200.. K0LM2320 

POT FILE (SYSPRINT) EDIT ('END OF SAMPLE PROGRAM') K0LM2330 

I SKI P( 2). COLUMN (10) ,A},. K0LM2340 

END,. /* END OF PROCEDURE KOLM ♦/KOLM2350 



TRIPLE EXPONENTIAL SMOOTHING EXPN 

Problem Description 

Given a time series X, a smoothii^ constant, and 
three coefficients of the prediction equation, this 
sample program finds the triple exponentially 
smoothed series S of the time series X. 
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Program 

Description 

The sample program for triple exponential smooth- 
ing consists of the main program, named EXPN, a 
special input routine, named DATS, and one sub- 
routine from the Scientific Subroutine Package- 
EXSM. 

Capacity 

The capacity of the sample program and the format 
required for data input have been set up as follows: 

(12F(6, 0)) format for input data cards. There- 
fore, if a problem satisfies the above conditions, 
the sample program need not be modified. How- 
ever, if input data cards are prepared using a 
different format, the input format in the input 
routine DATS must be modified. The general 
rules for program modification are described 
later. 

Input 

Control Card 

One control card is required for each problem and 
is read by the main program, EXPN. This card is 
prepared as follows: 



Columns 



1-6 



Contents 



For Sample Problem 



7-10 

11-15 
16-25 

26-35 

S6-45 



Problem number 
(may be alpha- 
meric) 

Number of data 
points In a given 
time series 
Smoothing constant, 
0! (0. < « < 1. 0) 
First coefficient 

(A) of the predic- 
tion equation 
Second coefficient 

(B) of the predic- 
tion equation 
Third coefficient (C) 
of the prediction 
equation 



SAMPLE 



00S8 



0.1 
0.0 

0.0 

0.0 



Smoothii^ constant and three coefficients must be 
keypunched with decimal points. 

Leading zeros do not have to be keypunched. 



Data Cards 

Time series data are keypunched using the format 
(12 F(6, 0)). This format assumes that each data 
point is keypunched in a six-column field, with 
twelve fields per card. 

Data Setup 

The deck setup is shown in Figure 35. 



Last problem 



Second problem 




First problem 



Procedures and main program 



The listing of input cards for the sample problem is 
shown in Figure 36. 



SAfFLE 


38 


1 


O.C 




O.C 






A26 


422 


41S 


414 


413 


412 




A^l 


447 


455 


461 


453 


446 




4E1 


483 


467 


491 


492 


465 


472 


470 













4C9 
466 



4U 
454 
482 



Figure 36. 

Output 

Description 

The output of the sample program for triple expo- 
nential smoothing includes: 

1. Original and updated coefficients 

2. Time series as input and triple exponentially 
smoothed time series 
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Sample 



Timii^ 



The output listing for the sample problem is shown 
in Figure 37. 



TRIPLE EXPONENTIAL St*OPTHiNG SAMPLE 



NU*iaEt5 CF OATfi POINTS 38 

SfCOTHING CCNSTfiNT C.KC 



COEfFICIENTS fl 


9 


C 


ORIGINAL C.CCC.rc 


c.oococ 


C.COOOO 


UPDATE <.8^.feC17c 


1. 71309 
SMOOIHEO OAT* 


C. 04 166 


INPUT DATA 


(FOFECAST) 




'■?C.CCCCC 


430.CCOO0 




'iZb.rcZCC 


^26.CCC0C 




^aa.crccc 


422.C00CC 




'ii<;.ccccc 


4I8.0CCOO 




414.'-CCCC 


Al'.. 29980 




'.i3.':cccc 


AIC.23950 




^l^.CCCCC 


A07.C8960 




(.Ca.CCC-C 


4C4. 66797 




'tU.CCCCC 


^02.22363 




^IT.CCCCC 


401.2 5049 




A22.CCCCC 


402.64575 




<.20.CCCCC 


405.61621 




A3S.CC?CC 


4K. 71338 




'.Al.CCCCC 


417.46948 




4-17. --CCCC 


423.99829 




^55.CCCCC 


431.18286 




'►fcl.CCCCC 


439.43359 




4'=3. recce 


447.87366 




■i^a.oocc 


452.21558 




■i^^.CCCrc 


'.54.10522 




^s^.ccccc 


455.80713 




465.CC0'"C- 


458.54614 




i-TCCCCCC 


463.30518 




'.TP.CCCCC 


469,06445 




<.7t.'-CC-C 


474.09521 




■iei.cofcc 


479.11C35 




4e3.ccccc 


48''. 38623 




-^ST.CCCCC 


488.94629 




A<;i.ccccc 


493.50854 




A-gs.ccocc 


498.05444 




^S-i.CCCCC 


501.66992 




'.S6.CCCGC 


5C£. 12549 




-taa.ccocc 


502. '.4434 




479,CCCCC 


501.16724 




47<;.rcGcr 


49P. 92749 




<.76.CCCCC 


496.84155 




^iz.cc-cc 


494.00806 




47C,CCCCC 


49C.3C420 





Figure 37. 

Program Modifications 

Input data in a different format can also be handled 
by providing a different format statement. In order 
to familiarize the user with the program modifica- 
tion, the following general rules are supplied in 
terms of the sample problem. 

Changes in the input format statement of the 
input routine DATS. 

Only the format statement and the variables 
per card count indicator (NF), which appears 
in subroutine DATS, can be changed. Since 
sample data are three-digit numbers, rather 
than usii^ siK-column fields, as in the sample 
problem, each data point might have been key- 
punched in a three-column field, with 24 fields 
per card. If so, the format is changed to 
(24 F(3, 0)) and the variables per card count in- 
dicator (NF) is changed to agree with the number 
of variables per data card. 

Operating Instructions 

The sample program for triple exponential smooth- 
ing is a standard PL/l program. Special operating 
instructions are not required. Data set SYSIN is 
used for input; data set SYSPRINT, for output. 



The execution of this sample program on a System/360 
Model 40, using a 2540 Card Reader as input and a 
1403 Printer, Model Nl, as output, is 33 seconds. 



«***«*♦**•*«**•*•**«****«*«*«»*•«**•*•*•*****•**•*•*********' 

TO PEAO THE PRDBLEH PARAMETER CARD AND A TIME SERIES, CALL 
THE PROCEDURE EXSH TO SMOOTH THE TIME SERIES, AND PRINT THE 
RESULT. 



«.*«««#»«**«******«******»• 



EXPN 

**/EXPN 

•/EXPN 

*/EXPN 

♦/EXPN 

*/EXPN 

*/EXPN 

««**«««. «.***/EXPN 

EXPN 



PROCEDURE OPTIONS (MAIN),. 
DECLARE 

(A,R,C,fiL) fLQAT BINARY, 

(I, NX) 

FIXED BINAPY, 

ER-tO^ EXTERNAL CHARACTER! 1 ) , 

CH CHARACTER (801, 

PRl CHARACTER (61,. 
/• 

ON ENDflLE ISYSIN) GO TO EXIT,. 
SlOC. 

GET EDIT ICH) (A(80)),, /* READ PROBLEM PARAMETER CARD 

GET STRING <CH) EDIT (PR l.NX , AL .A ,B ,C) 

(A(6».F(41,F15,0! .3 F(10,0)),. 

PRl PROBLEM NUMBER (HAY BE ALPHAMERIC) 

NX NUMBER CF DATA POINTS IN TIME SERIES 

AL SMOOTHING CONSTANT 

A,6,C.. .COEFFICIENTS OF THE PREDICTION EQUATION 



,PR1) (PAGE,SKIP(4) 



PUT EDIT ('TFIPLE EXPONENTIAL SMOOTHING 

COLUMN( 10), A, A) ,. 
PUT EDIT ('NUMBER OF DATA POINTS'. NX) ( SKIP ( 2) ,COLUMN( 10 1 , A, F( 611 
PUT EDIT ('SMOOTHING CONSTANT ', AL) (SKIP,COLUMN( 10 J , A, F( 9, 3) ) , . 
/* 

/« PRINT ORIGINAL COEFFICIENTS 
/« 

PUT EDIT ('CCEFFICIENTS'.'A'.'B'.'CM ( SKIP(2) ,COLUMN( 10) , A, 

X(14I,A.X(14) ,A).. 
PUT EDIT CORIGINAL'.A.B.C) ( SKIP( 2) .COLUMN( 10) , A,F( 19, 51 , 
2 F(15,5II,. 
ONE.. 

BEGIN,. 
OECLARt 

{X(NX),S(NX)) FLOAT BINARY,. 
CALL DAT3 (NX.X),. /* READ TIME SERIES DATA 

CALL EXSM (X,NX,AL,A,B,C,S),. 
IF ERROR Nt '0' 
THEN 00,. 

PUT EDIT ('IN ROUTINE EXSM ERROR CODE = '.ERROR) 

(SKIP(2),COLUMN(10),A,A(1)),. 
GU TO SlOO,. 
END.. 
/* 
/* PRINT UPDATED COEFFICIENTS 

PUT EDIT ('UPDATE', A, 6, C) ( SKI P( 2) ,COLUMN( 101 .*. FI 20t5), 
2 F(15,5) ),. 
/* 
/* PRINT INPUT AND SMOOTHED DATA 



EXPN 100 

EXPN 110 

EXPN 120 

EXPN 130 

EXPN 140 

EXPN 150 

EXPN 160 

♦/EXPN 170 

EXPN 180 

EXPN 190 

*/EXPN 200 

EXPN 210 

EXPN 220 

*/EXPN 230 

♦/EXPN 240 

*/EXPN 250 

♦/EXPN 260 

♦/EXPN 270 

♦/EXPN 280 

EXPN 290 

EXPN 300 

,. EXPN 310 

EXPN 320 

♦/EXPN 330 

*/EXPN 340 

♦/EXPN 350 

X(9»,A, EXPN 360 

EXPN 3 70 

EXPN 360 

EXPN 390 

EXPN 400 

EXPN 410 

EXPN 420 

EXPN 430 

♦/EXPN 440 

EXPN 450 

EXPN 460 

EXPN 470 

EXPN 480 

EXPN 490 

EXPN 500 

EXPN 510 

♦/EXPN 520 

♦/EXPN 530 

♦/EXPN 540 

EXPN 550 

EXPN 560 

♦/EXPN 570 

♦/EXPN 580 

♦/EXPN 590 

EXPN 600 



PUT EDIT ('SMOOTHED DATA*, 'INPUT DATA' ,'( FORECAST) ' » 

(SKIP(3),COLUMN(39),A,SKIP,COLUMN(17),A,X(13).A1,. EXPN 610 

PUT EDIT ((X(I),S(I) DO 1= 1 TO NX)) (SKIP.COLUMN( 10) ,F( 17. 5), EXPN 620 

X(8>.F(15,5I).. EXPN 630 

END,. «'"*« 6*0 

00 TO SlOO,. EXPN 650 

xIT.. E"*''^ *>*'^ 

PUT FILE (SYSPPINT) EDIT ('END OF SAMPLE PROGRAM') EXPN 670 

(SK1P(5).C0LUMN(10).A),. ^'^P'* ^^O 

Ef4P,. /•END OF PROCEDURE EXPN ♦/EXPN 690 



DAT3., 


DAT3 


10 


/***•***»»**«•«*•*♦♦*«♦♦*♦♦♦♦♦♦•♦♦**♦«♦♦♦*•**♦♦♦♦♦♦*«•**•*•**•****** 


♦♦/DAT3 


2C 


/* 


♦/DAT3 


3C 


/♦ TO READ A VECTOR OF FLOATING POINT DATA. 


♦/0AT3 


40 


/• 


♦/DAT3 


50 




♦♦/oaT3 


60 


PROCEDURE (M,D),. 


0AT3 


70 


DECLARE 


DAT3 


80 


CH CHARACTER ISO, 


DAT3 


90 


(I,M,N.Nl,N2) 


0AT3 


100 


FIXED BINARY, 


0AT3 


110 


DIM) FLOAT BINARY,. 


0AT3 


12C 


/« 


«/0AT3 


130 


/♦ N EQUAL THE NUMBER OF DATA POINTS PER 80 COLUMNS OF A DATA 


*/DST3 


140 


/* CAi'O. 


"■/DATS 


150 


/* 


*/DAT3 


160 


ON ENDFILE (SYSIN) 


0AT3 


170 


GO TO EXIT,. 


DATS 


180 


N =12,. 


DAT3 


19C 


Nl =1, . 


OAT? 


200 


N2 =N, . 


0AT3 


210 


SIC. 


04T3 


220 


IF M LE N2 


0AT3 


230 


THEN N2 =M,. 


DAT3 


240 


GET EDIT (CH) (A(SC)),. 


DAT3 


25C 


GET STRING (CH) EDIT ((D(I) 00 I- Nl TO N2») ( (N) F( 6,0) ) , . 


DAT 3 


260 


Nl =N2*1,. 


0AT3 


270 


IF Nl LE M 


0AT3 


280 


THEN DO, . 


DAT3 


290 


N2 =N2+N, . 


DAT3 


300 


GO TQ SIO,. 


DAT3 


310 


END,. 


0AT3 


320 


REVERT ENDFILE (SYSIN),. 


DAT3 


330 


RETUPN, . 


0AT3 


340 


EXIT. . 


DAT3 


350 


PUT FILE (SYSPRINT) EDIT ('ERROR INSUFFICIENT DATA') 


DAr3 


360 


(SKIPtU.COLUMNdO) ,A),. 


DAT3 


370 


STOP,. 


DAT3 


380 


END.. /♦END OF PROCEDURE DATS 


♦/0AT3 


39C 
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ALLOCATION OF OVERHEAD COSTS (COST) 
Problem Description 

A standard problem in finance is the allocation of 
overhead costs (for example, electricity, transpor- 
tation, . . . ) to productive (charge) departments. 

Overhead costs are initially charged to auxiliary 
departments. The costs of the auxiliary depart- 
ments must be distributed among the productive 
departments using a given allocation key. For any 
auxiliary department the allocation key gives the 
distribution of unit costs amoi^ all departments 
(productive and auxiliary). 

The problem is to calculate a transition matrix 
that can be used to obtain the final cost allocation 
to productive departments (by multiplying it with 
the given cost vector). 



and by iteration 






A realistic allocation key requires each auxiliary de- 
partment to allot part of its costs to productive de- 
partments. 

Under this assumption for the elements r.. of R. 

ik 



s r s a < 1 for all i = 1, 2, 



ik 



k = l,2, . 



, n 
, n 



(4) 



and 



Mathematical Background 

The calculation procedure is best described using 
matrix notation. 

Let n be the number of auxiliary departments 
and m the number of productive departments. 

The given allocation keys form a matrix K of 
dimension n+m by n, where the i-th column gives 
the distribution of unit costs of the i-th auxiliary 
department among all m+n departments. 



K 



n-columns 
/R\] n-rows 



m-rows 



(1) 



K (given) is segmented into two parts, R and S. 

R is of dimension n by n and S of dimension m 
by n. R contains the allocation keys for chargii^ 
auxiliary departments by an auxUiary department, 
while S contains the allocation keys for charging 
productive departments by an auxiliary department. 

If R is null, S is already the required transition 
matrix. 

Note that all elements of K are nonnegative and 
that the sum of all elements in any column is one. 

Let C be the vector of dimension n+m containing 
the costs of auxiliary departments (first n elements) 
and the costs of productive departments (last m 
elements): 



/CA\} 

Icpj] 



n 

m 



(2) 



Distributing overhead costs CA according to allo- 
cation key K gives a new vector 



S = 



^CAj\ CAj=R.CA 

] with 
CP^J CP^ = S. CA + CP 



(3) 



X; r., sa<iforallk = l,2 n 



i=l 



ik 



(5) 



This means R -► for k -♦ <» and I-R is nonsingular. 

Therefore, iteration (3) will give the allocation 
of costs C to productive departments. 

One step is sufficient if R = (when no auxiliary 
department is chargii^ an auxiliary department 
again). 

The process (3) is easily described in matrix 
notation: 



^n ^> ^1. " 



Therefore: 

lira /r 
k -♦ => I s I 



R 

S I 



k-1 



R 

S I 



(6) 



lim 



\sa+R+...+R''"-') I 



k-l 




T I 



defines the desired transition matrix T, which will 
give the final cost allocation with a single matrix 
multiplication: 



T = lim S • (I+R+. . . + R ) = S • (I-R)""^ 

k ->" 



The rows of T may be calculated one at a time from 

T -T T 

T^ = (I-R) . S^ (7) 
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Programming Considerations 

Calculation of T is done in two major steps: 

1. The matrix (I-R)'^ is factored into a product 

of two triangular matrices L • U = (I-R)"^. 

T 

2. The column vectors of S (that is, row vec- 
tors of S) are divided by the triangular factors L and 
U. 

Doii^ tiie second step sequentially, one column 
at a time, saves considerable storage space, since 
the only data needed in core simultaneously is an 
nby n matrix, containing (I-R)T, the triai^ular 
factors L and U, and a vector of dimension n. This 
allows calculation of the transition matrix T, which 
allocates overhead costs, for a very large number 
of charge departments, as loi^ as the number of 
auxiliary departments is of moderate size. 

Program 

The program for allocation of overhead costs con- 
sists of the main pro^^ram, COST, and two proce- 
dures from the Scientific Subroutine Package: 
MFC — triangular factorization of a general 

matrix 
MDLG — division by triai^ular factors from left- 
hand side 



Data Cards 

The rows of matrix K = ( g j are read into the com- 
puter one at a time. 

The elements are keypunched in successive 
cards, assuming six 10-column fields per card. 
These fields are 11-20, 21-30, 31-40, 41-50, 51-60, 
61-70. Columns 1-4 are used for identification of 
the row. Each row must start with a new card. An 
input format of F(10, 8) is used for the ten-column 
fields. 

Deck setup is shown in Figure 38. 



Last problem 





/ 

Data 


^ Control 
Cord 


/ 





r~ 


Data 




Control 








Cord 






y 



-Irst problem 





















MFG 
















/ 


MDLG 












/ 


COST 








y 



Procedures and moin program 



Capacity 



Figure 38. 



The limitation on the number of auxiliary depart- 
ments depends on the size of storage available for 
data. The number of productive depai/tments is 
not limited by core size. 

Dynamic storage allocation is used for data ar- 
rays with extent n+ 1 by n. 

Input 

One control card is required for each data set. 
This card is prepared as follows: 



Columns 



1-10 



11-15 



Contents 

Problem number 
(may be alpha- 
meric) 

Number of auxil- 
iary departments 



For Sample Problem 



HILBERT 



Sample 

A listii^ of input cards for the sample problem is 
shown in Figure 39. 



AAOl 
AA02 
AA03 
AA04 
AA05 
AA06 



AAOL 
AA02 
AA03 
AA04 



0.341417*30.247540110.207916319. 185625310. 171 199560. 161046S6 
0.170708710.165026720.155937250.148500200.142666220.13804018 
0. 113805770. 123770050. 124749770. 123750150. 122285360.1 20785 17 
0.085354320. 099016010.10395812 0. 106071590.106999690.10736459 
0.068283430.082513330.089106970.092812650.095110830.09662812 
0.056902890.070725730.077968590.082500100.085599720.08784371 



0.048773910.061885020.069305410.074250100.077817910.08052343 
0.042677180.055008910.0623 74890.067500050.071333110.07432 931 
0.037935260. C49508 000. 056704450. 06 18 75090.0 65 845960. 06902003 
0.034141730.045007280.051979080.05 7115480.061142670.06441873 



Figure 39. 



16-20 Number of pro- 4 

ductive departments 

Leading zeros do not have to be keypunched. 



Output 

As output, the resulting transition matrix T is 
listed rowwise. 
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Sample 

The output listing for the sample problem is shown 
in Figure 40. 



afiC2 
»fC3 



' flLLOCfiTION OF OVERHESD COSTS « 

PRCILEM . MILBERT 

NDMBEE OF AUXILIARY OEPARTHENTS • 6 

»U>(3ER OF PRODUCTIVE 0EP4RTI-ENTS » 4 

RfSUir«NT ERROR INOICtTOR WITHIN PROCEDURE NFG ERROR -0 

a.9C8I7<.,»E- = I 2.e,83,W,E-C. ..e»75,.nE-CI 2.aTT,„„E-C. ..,„0„=5E-0I . 

..5,ei,s.5E-.M ^.S,aTM3eE-CI .. .„0T.56E-C I ..„„.„TE-OI ..„I«TTOE-0. ^ 

2.,.,.3.,3E-OI ..35,U«,E-0. .. ,,T„33CE-CI ..3M3C.,TE-0. a.3M,0,C5E-CI . 

..K..3„3E-0I ..I5.,C.«E-CI .. , .0C.,3»-C I ..I.T,„«,-„. ,. i,„,OT.E-CI / 



8597C27ie-01 
58998632E-01 
36ei414lF-01 
18217134E-01 



Figure 40. 



Program Modificatio ns 

Input data in a different format can be handled by 
providing different formats in corresponding GET 
EDIT statements. 

Error Messages 

The value of the error indicator as set by procedure 

MFG is included in the listing: 

ERROR = 'O' means successful factorization, 
means incorrect value N. 
means incorrect data matrix R. 
(I-R) is singular. 

means (I-R) is nearly singular. To 
avoid a breakdown of the method, in- 
put data has been slightly modified, 
means (I-R) is nearly singular. 
Results may have poor accuracy. 

In the case ERROR = 'S', calculation is bypassed. 



ERROR = 'P' 
ERROR = 'S' 

ERROR = 'C 



ERROR = 'W 



Operating Instruct ions 

The sample program for overhead cost allocation 
is a standard PL/l procedure. Special operating in- 
structions are not required. Data set SYSIN is used 
for input; and data set SYSPRINT, for output. 

Timing 

The execution time of this sample program on a 
System/360 Model 40, using a 2540 Card Reader and 
a 1403 Printer, Model N2, as output, is 19 seconds. 



■*v****tt^ft,t*m*****t^*t** 



• »***»**»♦*«♦*,„«» ,*,j^ 



ALLOCATION OF OVERHEAD COSTS 



PROCEOUPE OPTIONSIMAIN),. 
DECLARE 

ERROU EXTERNAL CHARACTERU), 

(CNP.CHNF) CHAPACTERaC), 

CH CHARACTERd), 

EPS BINARY FLOAT, 

tI.INO,K,L.M,NI 

BINARY FIXED,, 
ON ENOFILE (SYSIN) GO TO BACK,. 
START.. 

EPS =lE-6.. 
GET EDIT 

fCNR,N,H,CH) 

(A(10),f(5),F(5),X(59),A(l)) 
PUT EDIT 



'*»**m*******^^t**-> 



K»*««**> 



COST 

•****«*«, »/CQsr 

*/COST 

*/COST 

♦/COST 

•*********/COST 

COST 



/•EXTERNAL ERROR INDICATOR 



COST 

*/COST .. 

COST ICO 

COST 110 

COST UC 

COST 130 

COST 140 

/•SET EPS FOR INTERNAL TEST FOP*/CDST 160 
/•LOSS OF SIGNIFICANT DIGITS •/COST 170 

/•READ NUMBER OF COLUMNS, ROMS */COST 190 

/•WRITE HEADING "'' '"' 



ALLOCATION OF OVERHEAD COSTS 



( PAGE, SKI PI 2), t 5) (X( 30), A, SKIP)),. 
PUT EDIT * 

Iwrift^^nc^oI^I?''''"^''^" °^ AUXILIARY DEPARTMENTS = 
'NUMBEP OF PRODUCTIVE DEPAPTWENTS =',M) 
*^^IPI2),XI30I,A.A,(2)(SKIP(2),X(30),A,F(5))),. 
DECLARE 

tR(N.N),SIN,l). 

WIN) DEFINED SllSUB,!)) 

BINARY FLOAT 



BINARY FLOATI53), 

IPER(N) 

BINARY FIXED,. 

= 1.. 

=N,. 

DO WHILE (L GT 6), 

L =L-6,. 

IND =IND+l,. 

END,. 

=(6-L)*10,. 

DO I =1 TO N,. 

GET EDIT 

(CHNR,H) 

(AtlC).(IND)((6)F(lO,e),XC20)l) 



•/COST 210 
COST 22C 
COST 23C 
COST 24C 
COST 25C 
COST 2feC 
COST 270 
COST 280 
COST 290 
COST 3CC 
COST 310 
COST 320 
CnST 330 
COST 34G 

/•SINGLE PRECISION VERSION /♦S+yCOST 360 

/•DOUBLE PRECISION VERSION /•0*/CDST 370 

COST 38C 

COST 39C 

•/COST 40C 

•/COST ^IC 

COST 420 

/•IND MEANS THE NUMBER OF CARDS*/COST 440 
/•FOR ONE ROW OF P ./cqst 450 

/*L SPECIFIES HORIZONT. SPACING«/COST 460 
/•EXECtJTE LOOP OVER ROWS OF R •/COST 470 
/•READ I-TH ROW OF MATRIX R 



/•CALCULATE VALUES Fpo INPUT 
/•FORMAT LIST 



GET EDIT 

(CNR) 

(X(L),A(10I),. 
W(U =h(I)-I,. 

R(*,I)=-H,. 

END, . 
CALL MFG(R,IPER,N,EPS),. 
PUT EDIT 



/•HORIZONTAL SPACING 



/•COMPUTE TRANSPOSED (U-R) 
/•WHERE U MEANS UNIT MATRIX 



•/COST 480 

COST 490 

COST 5CC 

♦/COST 51G 

COST 520 

COST 530 

•/COST 540 

•/COST 550 

COST 560 

/•CALL FACTORIZATION PPOCEDURE •/COST 570 

[l /*WRirE ERROR INDICATOR OF MFG ♦/COST 5«n 

'RESULTANT ERROR INDICATOR MITHIN PROCEDURE MFG*. COST III 

•ER^OP -SERfiOP)(SKIP(3I,X(lO),A,X110),A,A),. COST 600 

??T Pn T "•• /•EXECUTE LOOP OVER ROWS OF S •/COST 610 

(^^T EDIT /•READ ANY ROW OF MATRIX S 

(CHNR,Nt 

(A(irj,(iND)((ejF( ip,ei,X(20))>,. 
GET EDIT 

(CNRl 

(X(L),A(1C)),. 
IF ERROR NE "S* 

^^^"^ l^"" /•PERFORM MATRIX DIVISION 

CALL MOLG(R,S,IPER,N,lB,'0'),. 
PlJT EDIT /•MRITE ALLOCATION ROW 

(CHNR.W) 
END '^'^"''^'•''*^''*'''*5'**'^°"*6>E"7,8),X(18))) 
END,. 
END, . 
GO TO START,. 
lACK., 

^'*°" /•END OF PROCEDURE COST 



♦/COST 620 
COST 630 
COST 640 
COST 650 
COST 660 
COST 670 
COST 680 

•/COST 690 
COST 700 

•/COST 710 
COST 72P 

. COST 730 
COST 740 
COST 750 
COST 760 
COST/770 
QOST 780 

•/COST 790 
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